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1.  INTRODUCTION 


In  PART  ONE  of  the  OIL-PPM  report  the  equations  of  motion  were  derived. 

'*  from  first  principles  and  discussed  from  a  fundamental  point  of  view.  PART 
WO  then  described  the  difference  equations,  the  equation  of  state,  the 
constitutive  equations  and  the  differencing  scheme  for  velocity  gradients 
used  in  formulating  the  FORTRAN  IV  program.  Here,  in  PART  THREE,  the  com¬ 
puter  program  is  listed  in  detail  and  the  general  information  necessary  to 
set  up  and  run  problems  is  provided.  A  dictionary  of  terms  vised  in  the 
program  is  also  included,  as  well  as  a  number  of  tables  and  charts  des¬ 
cribing  the  program  in  outline  form.  Forms  for  setting  up  a  sample  problem 
are  also  given.  This  information  provides  the  user  with  a  capability  to 
run  his  own  problems  and,  in  addition,  the  intent  is  to  describe  the  code 
in  enough  detail  that  any  changes  the  user  may  require  can  be  readily  made. 

The  program  is  the  result  of  contributions  by  quite  a  number  of  people 

whose  names  are  cited  in  the  references.  Briefly,  the  techniques  described 

here  originated  from  the  PIC  particle- in- cell  method  developed  at  Los  Alamos 

by  Evans  and  Harlow^ )  and  programmed  in  machine  language.  The  code  was 

rewritten  in  FORTRAN  and  modified  for  application  in  the  ORION  program  by 

(2) 

Johnson'  '  and  the  General  Atomic  version  was  called  SHELL.  At  the 
suggestion  of  B.  E.  Freeman  a  continuous  version  was  developed  by  Walsh 
and  Johnson^)  for  tne  solution  of  hypervelocity  impact  problems  and  called 
OIL.  It  made  use  of  the  equation  of  state  programmed  by  Tillotsor^'.  To 
develop  OIL,  the  particles  were  replaced  by  a  continuously  varying  mass  in 
each  cell.  The  capability  to  run  multi-material  problems  could  not  be  con¬ 
veniently  retained  (the  particles  in  PIC  could  be  of  different  materials). 
However,  the  cost  of  running  problems  was  significantly  reduced  and  the 
flow  profiles  were  substantially  smoother,  making  it  practical  to  run  impact 
and  explosion  problems  out  to  a  time  when  the  shock  pressure  was  down  to  a 
few  kilobars.  The  lowest  pressure  that  could  be  resolved  with  PIC  was 
several  hundred  kilobars. 

In  order  to  compute  crater  size  from  an  impact  directly,  the  shear 
strength  of  the  cratered  material  had  to  be  accounted  for.  The  necessary 
changes  to  OIL  were  made  in  an  experimental  way  by  Johnson,  Walsh,  and 
Dienes- in  1965 .  This  modified  version  of  OIL  was  called  OII/-RPM. 
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Sub sequent ly,  when  it  had  been  shown  that  crater  size  could  be  cal¬ 
culated  with  satisfactory  accuracy,  the  program  was  streamlined  by  the 
authors  so  it  could  be  used  in  production  runs,  and  additional  editing 
features  were  incorporated.  The  current  version  has  been  used  in  cal¬ 
culating  over  50  different  problems  and  the  results  have  generally  com¬ 
pared  ve3_L  with  experiments,  analytical  solutions  and  other  hydrodynamic 
codes. 
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2.  DESCRIPTION  OF  THE  PROGRAM 


The  equations  of  motion  are  integrated  in  Phases  1,  2  and  3  which 
account  for  the  effect  of  pressure,  transport,  and  shear  stresses  res¬ 
pectively*  In  addition  to  these  subroutines,  ten  others  have  been  intro¬ 
duced  for  the  various  peripheral  tasks.  These  include  INPUT,  SETUP,  CARDS, 
CDT  (computes  time  step),  EDIT,  MAP  (provides  displays),  ES  (equation  of 
state),  REZONE  and  ERROR-  "RPM"  is  used  to  denote  both  the  routine  con¬ 
trolling  the  main  flow  and  the  entire  program;  the  choice  is  gene redly 
made  clear  by  the  context.  A  summary  of  the  subroutines  is  given  in 
Table  1  in  the  order  in  which  they  appear  in  the  listing  provided  in 
Section  6.  Included  in  the  table  are  the  names  of  the  subroutines  calling 
and  called  by  each  of  the  others.  A  few  general  comments  are  made  in  the 
paragraphs  below  on  each  of  the  subroutines. 

2.1.  RPM 

The  overall  flow  of  the  program  is  controlled  by  RPM,  as  shown  in  the 
flow  chs  't  of  Fig.  1.  RPM  controls  whether  additional  information  is 
printed  at  intermediate  phases  of  tne  calculation  cycle  for  diagnostic 
purposes  and  debugging.  The  variable  "INTER"  contro?.s  these  intermediate 
prints.  When  INTER  »  0,  no  intermediate  prints  are  made.  When  INTER  ^  0 
EDIT  is  called  and  on  print  cycles  EDIT  prints  are  made  after  PHI  and  PH3 
as  well  as  after  CDT.  Detai ls  of  the  Phase  2  calculation  are  obtained  in 
addition  to  the  EDIT  prints  r/  putting  INTER  =-7,  which  causes  printing  of 
the  energy  and  mass  transported  as  each  cell  is  processed.  For  debugging 
of  Phase  3  difficulties  one  puts  INTER  »  99  and  thereby  obtains  detailed 
prints  of  stresses,  strain  rates  and  a  few  other  parameters.  These  options 
should  be  used  with  extreme  caution  since  an  intermediate  print  vises  con¬ 
siderable  paper. 

2.2.  INPUT 

Instructions  for  running  problems  are  interpreted  by  INPUT,  which  can 
either  start  or  restart  a  calculation.  It  calls  SETUP  and  CARDS,  as  neces¬ 
sary,  to  prescribe  the  initial  conditions  and  to  read  the  input  deck.  A 
flow  chart  showing  the  relation  of  INPUT,  CARDS,  and  SETUP  is  provided  in 
Fig.  2. 
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TABLE  1 


ORDER  OF  F.  JBR0UTINE8 


Name 

Culled.  From 

Calls 

RPM 

INPUT,  COT,  EDIT 

PEL,  PH2,  PH3 

INPUT 

RPM 

SETUP,  CARDS 

CARDS 

INPUT,  SETUP 

— 

SETUP 

INPUT 

CARDS,  ERROR 

CDT 

RPM,  EDIT 

ES,  ERR® 

ES 

CDT 

— 

EDIT 

RPM,  ERROR 

MAP,  REZONE, 

ERROR,  COT 

MAP 

EDIT 

PHI 

RPM 

— 

P3i3 

RPM 

— 

PH? 

RPM 

ERROR 

REZONE 

EDIT 

— 

ERROR 

SETUP,  CUT 

EDIT,  PH2 

EDIT 

FLCW  OF  THE  CONTROL  SUBROUTINE  RPM 


Fig.  1— Flow  chart  of  main  sequence 
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FLOW  DIAGRAM  OF  INPUT,  CARDS  AND  SETUP 


Fig.  2 
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2.3.  CARDS 


The  reading  of  the  input  deck  is  called  by  this  simple  subroutine. 
Details  are  given  in  Fig.  2. 

2.4.  SETUP 

The  initial  conditions  for  running  problems  are  generated  by  SETUP. 

The  most  commonly  used  options  are  those  in  which  a  sphere  or  a  cylinder 
(called  the  projectile)  hits  a  targe"  of  finite  thickrNss.  The  target  of 
infinite  thickness  is  an  important  special  case.  Another  option  is  a 
geometry  in  which  a  sphere  hits  a  thin  plate  (called  the  projectile)  which 
has  a  filler  behind  it  (typically  void  or  of  underdense  "foamy"  material) 
and  then  hits  a,  second  thin  plate  behind  the  filler.  Further  details  are 
given  in  Section  3  describing  how  to  set  up  various  problems. 

(3) 

In  an  earlier  reportw  describing  the  OIL  code  a  description  and 
FORTRAN  listing  of  a  special  generator  code,  CLAM,  was  given.  This  program 
provides  a  very  general  method  for  specifying  initial  conditions  and  for 
setting  up  OIL-RPM  problems.  A  few  changes  in  CIAM  are  required  to  make 
the  write  statements  for  the  CLAM  dump  tape  conqiatible  with  the  READ  state¬ 
ments  in  OIL-RPM, 

2.5.  CDT 


The  principal  function  of  this  subroutine  is  to  compute  a  time  step 
which  ensures  stability  of  the  finite  difference  equations.  This  is  done 
by  finding  the  minimum  of  D/w  for  all  the  cells.  Here  D  denotes  the  mini¬ 
mum  of  the  radial  and  axial  cell  dimensions,  and  w  denotes  the  maximum  of 
the  radial  velocity,  axial  velocity  and  sound  speed.  For  vaporized  material 
sound  speed  is  computed  by  Jy p/p  and  for  solid  materials  by  the  approxi¬ 
mate  relation  C  ■  CQ  +  B  J~p  where  p  is  the  pressure  in  the  cell.  The  co¬ 
efficient  B  is  obtained  by  determining  a  typical  slope  for  the  isentropes 
in  Ref.  4  and  using  the  relation 


to  evaluate  "B  ^at  a  particular  point.  The  pressure  array  is  updated  in  CDT 
by  calxing  the  equation  of  state  subroutine  ES. 


The  array  JPM(l)  which  determines  the  location  of  the  pressure  maxi¬ 
mum  and  hence  the  cells  on  which  deviator  stresses  act  is  also  computed  in 
CDT. 

Unrealistic  behavior  in  free  surface  cells  containing  a  small  amount 
of  mass  would  occur,  in  the  absence  of  a  special  treatment,  when  a  neigh¬ 
boring  cell  has  a  high  pressure.  This  causes  large  accelerations  of  the 
mass  in  the  cell  containing  a  free  surface,  and  eventually  velocities  which 
are  physically  unrealistic.  This  difficulty  is  alleviated  by  reducing  the 
pressure  computed  by  the  equation  of  state  by  a  factor  which  is  the  ratio 
of  the  smallest  mass  in  an  adjacent  cell  to  the  mass  in  the  cell  itself. 
This  factor  reduces  the  pressure  at  the  interface  to  a  value  which  accounts 
for  *he  position  of  the  free  s'u-face. 

2.6.  £S 

The  equation  of  state  subroutine  is  called  by  COT  to  evaluate  the 
pressure  as  a  function  of  density  and  internal  energy.  The  general  method 
was  originally  described  in  Ref.  U,  but  a  number  of  modifications  have  been 
made  since  that  report  was  written.  A  general  discussion  is  given  in 
Section  h  of  PART  TWO.  Values  of  the  parameters  for  a  number  of  materials 
are  listed  in  Table  2.  Paramerers  for  some  materials  not  given  in  Ref.  k 
are  supplied  in  Refs  6  and  "• 

2. 7.  FUIr 

The  pressure,  velocities,  density,  specific  internal  energy,  and  mass 
for  each  cell  are  displayed  by  EDIT  in  a  "long"  print.  It  also  prints  out 
the  total  internal  energy,  kinetic  energy,  axial  and  radial  momentum  and 
mass  above  and  below  a  dividing  line  which  is  the  top  of  the  cell  whose  J 
index  is  JPROJ.  The  changes  in  energy  due  to  evaporation  and  losses  out 
the  boundaries  are  also  accounted  for  in  the  EDIT  prints.  The  crater  depth 
is  calculated  by  "packing  down"  material  in  each  column  to  its  normal 
density.  This  describes  in  a  rough  way  the  extent  of  the  cr»t«r  even  while 
it  still  contains  low  density  material. 

"Short"  EDIT  prints  display  the  integrated  quantities,  and  the  cell 
variables  for  the  one  coV-tun  of  cells  that  is  adjacent  to  the  ends.  These 


8 


EQUATION  OF  STATE  CONSTANTS  FOR  SEVERAL  MATERIALS 


These  fits  Include  additional  parecetcr; 


short  prints  require  only  a  few  pages  of  printing,  and  hence  are  normally 
called  for  at  more  frequent  intervals  than  the  "long"  prints. 

Tracer  points  are  positioned  at  the  center  of  every  other  cell  in 
SETUP,  and  the  positions  of  these  points  are  updated  in  PH2.  The  current 
position  of  each  tracer  point  is  printed  in  both  the  long  and  the  short 
prints,  providing  the  basis  for  a  Lagrangian  description  of  the  flow.  The 
positions  are  written  on  the  restart  dump  tape  and  can  be  used  by  plot 
routines  to  make  a  plot  of  material  deformation. 

2.8.  MAP 

This  sburoutine  is  called  by  EDIT  and  displays  the  properties  of  each 
cell  in  the  active  grid  using  an  alphabetic  scale.  One  obtains  contour 
maps  of  the  density,  pressure,  radial  and  axial  velocities,  and  internal 
energy  in  the  active  grid. 

2.9.  PHI 

The  effect  of  the  pressure  gradient  in  updating  the  velocities  and 
the  internal  energy  is  computed  here.  The  calculation  method  is  described 
in  detail  in  Section  3.2  of  PART  TWO. 

2.10.  PH3 

The  deviator  stresses  acting  on  each  cell  edge  and  the  hoop  stress 
are  determined  in  PII3  and  the  resulting  velocity  and  energy  increments  are 
computed.  Details  are  given  in  Section  5  of  PART  TWO.  If  CYCPH3  is  -1, 

Phase-  3  is  bypassed  and  the  effect  of  strength  is  not  accounted  for  in  the 
calculation.  In  this  case  the  code  is  "hydrodynamic"  in  the  classical  sense. 

2.11.  PH2 

Mass  transport  and  the  associated  flux  of  momentum  and  energy  are 
accounted  for  in  PH2.  The  tracer  points  are  also  moved  with  velocities 
obtained  by  a  simple  weighting  scheme. 

2.12.  REZONE 

The  masses  of  four  cells  are  lumped  into  one  in  this  subroutine.  The 
JIM,  DX,  BY,  X,  Y,  and  TAU  arrays  are  adjusted  accordingly.  Momentum  and 
total  energy  are  conserved,  thereby  converting  seme  kinetic  energy  into 
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internal  in  a  process  loosely  called  "thermalizing. "  Every  other  tracer 
point  is  deleted  in  rezone,  and  new  tracer  points  are  placed  in  the  added 
cells,  retaining  constant  the  total  number  of  tracer  points. 

2.13.  ERROR 

This  subroutine,  which  is  called  in  the  case  of  certain  error  condi¬ 
tions  tested  on  by  the  code,  prints  a  message  identifying  the  error  condi¬ 
tions,  calls  EDIT  for  a  long  print  and  tape  dump,  and  then  calls  EXIT. 

2.14.  TAPE  DUMPS 

Each  OIL-RPM  tape  dump  consists  of  eight  or  nine  records  depending  on 
whether  tracer  points  are  used.  (See  list  below.)  The  first  record  con¬ 
tains  three  words:  555 the  value  of  CYCLE  at  the  time  of  the  dump,  and 
the  value  of  N3  (N3  =  1  when  tracer  points  are  used;  otherwise,  N3  a  0). 

The  last  record  also  contains  three  words:  666.0,  666.0,  666.0.  However, 
before  each  dump  after  cycle  0,  TAPE  7  is  backspaced  one  record  and  this 
last  record  is  written  over.  Therefore,  this  last  record  remains  only  on 
the  last  dump  of  a  run  and  in  that  case  is  followed  by  an  end  of  file  mark. 

On  cycle  0,  after  all  input  cards  but  the  last  have  been  read  and  the 
properties  of  all  cells  have  been  defined,  SETUP  does  a  tape  dump.  There¬ 
after,  all  tape  dumps  are  made  by  EDIT  at  set  intervals  defined  by  NDUMP7 • 
However,  when  NODUMP  0.  all  tape  dumps  after  cycle  0  are  suppressed. 

This  makes  it  possible  to  restart  a  problem  from  a  dump  tape  without  writing 
on  the  dump  tape  which  is  sometimes  useful  in  special  studies. 


Record  Number 

Description 

1 

555.0,  CYCLE,  N3 

2 

Z(I),‘  1  =  1,  J-ET 

3 

U(I),  V(l ),  AMX(l),  AIX(l), 
?(I),  1=1,  KMA>*' 

4 

X(0),  (X(l ),  TAU(l),  JPM(I), 

I  =  1,  IMAX) 

5 

Y(l),  1  =  0,  JMAX 

6 

i 

( (XP(l,  J ),  YP(l,  j),  I  -  1,  I! 
J  =  1,  JJ) 

7 

DX(l),  1=1,  IMAX 

8 

DY(I),  1  =  1,  JMAX 

9  ! 

666.0,  666.0,  666.0 

11 
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3.  SET-UP  OF  PROBLEMS 


Most  calculations  performed  with  the  OIL-RPM  code  involve  either  a 
sphere  or  a  cylinder  hitting  a  target.  Since  the  cylinder  (which  is  called 
a  "projectile"  in  the  code)  can  he  stationary,  the  set-up  can  also  provide 
for  a  sphere  hitting  a  two- layer  target  with  or  without  filling  material 
between  the  layers,  as  sketched  in  the  diagram  below. 

The  geometries  described  by  the  code  are  limited  by  the  following 
requirements : 

1.  The  Y-axis  of  the  "sphere"  must  be  on  the  Y-axis  of  the  grid, 
i.e.  the  cede  cannot  setup  problems  involving  toroids. 

2.  The  center  of  the  sphere  must  coincide  with  a  cell  boundary. 
(Note:  the  center  can  be  at  the  origin  of  the  grid.) 

3.  The  edge  of  the  sphere  should  be  contiguous  with  the  projectile 
or  target. 

h.  The  projectile  package  is  assumed  to  be  below  the  target 
package. 

5.  The  filler  material  can  t_  placed  only  between  the  projectile 
package  and  the  target  package  and  extends  out  to  the  right 
boundary  of  the  grid. 

6.  The  right  and  top  boundaries  of  the  grid  are  transmittive, 
although  the  bottom  boundary  can  be  either  reflective  or 
transmittive. 


Sphere 


density 


of  material  is  RHOFIL 
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The  input  cards  for  setting  up  an  OIL- RPM  problem  define  (l)  the 
dimensions  of  the  grid  as  well  as  the  packages  (sphere,  projectile,  and 
target);  (2)  the  properties  of  the  packages  (density,  velocity,  and  specific 
internal  energy);  (3)  the  physical  constants  used  in  the  equation  of  state 
and  yield- strength  calculation;  (4)  the  calculational  constants  used  in 
defining  various  cutoffs  and  flags;  (5)  the  frequency  of  printing  and  of 
writing  on  the  restart  tape;  and  (6)  the  time  or  cycle  at  which  to  stop 
execution. 


Most  of  the  input  variables  are  equivalenced  to  an  element  in  the 
2-array,  the  first  array  in  Blank  Common.  The  variables,  therefore,  are 
identified  on  the  input  cards  by  their  location  in  Blank  Common  (i.e.,  in 
the  Z-array).  The  list  that  follows  gives  the  variable  name  associated 
with  each  input  number,  its  location  in  Blank  Common,  and  a  brief  descrip¬ 
tion  of  its  function  in  the  code. 


Following  this  list  will  be  a  discussion  of  the  format  and  order  of 
the  input  cards,  and  the  RPM  Setup  Sheets  illustrating  the  input  for  a 
typical  impact  problem. 


3.1.  DEFINITION  OF  RPM  INPUT  VARIABLES 

3.1.1.  Identification 


Variable  Location  in 
Name  Blank  Common 


PK(1)  151 


PROB  1 


Definition 

The  problem  number  can  be  any  number  with  at 
most  2  places  to  the  left  and  at  most  4  to 
the  right  of  the  decimal  point.  (Range: 

00.001  to  99*9999) 

The  problem  number  is  repeated  if  this  is  a 
new  problem  just  being  set  up.  (It  is  not 
repeated  for  restarts  from  tape.  See  "RPM 
Input  for  Restart.") 
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3.1.2.  Dimensions 


Variable 

Name 

IMAX 


JMAX 


II 


12 


DXI 

DYF 

X(I) 

Y(J) 


Location  in 
Blank  Common 


33 


35 


h7 


L8 


136 

137 
269 


166 


Definition 

The  number  of  columns  in  the  calculational 
mesh.  IMAX  £  50  for  the  standard  version. 
Unless  IMAX  =  1  for  1-D  problem,  IMAX  must 
be  even  in  order  to  rezone  the  grid. 

The  number  of  rows  in  the  calculational  mesh. 

In  the  standard  version  JMAX  £  100,  and  IMAX 
times  JMAX  £  2500,  JMAX  must  be  even  to 
rezone  the  grid. 

The  right- most  column  to  be  calculated  in¬ 
itially.  It  should  be  two  columns  beyond 
the  last  column  with  non-zero  energy 
(kinetic  or  internal).  (II  £  IMAX) 

Tne  top  row  to  be  calculated  initially.  It 
should  be  two  rows  above  the  last  column  with 
non- zero  energy.  (12  £  JMAX) 

II  and  12  define  the  "active  grid."  II  and  12 
are  automatically  adjusted  as  the  problem  runs. 

The  value  of  all  the  DX's  if  DX  is  constant. 

The  value  of  all  the  DY's  if  DY  is  constant. 

The  number  of  cms.  from  the  axis  to  the  right 
side  of  column  I.  The  x-array  is  included  in 
the  input  deck  only  if  the  rad?al  dimension 
of  the  cells  varies. 

The  number  of  cms.  from  the  bottom  of  the 
grid  to  the  top  of  row  J.  The  Y- array  is 
included  in  the  input  deck  only  if  the  axial 
dimension  of  the  cells  varies.  . 


Ik 


3*1. 3*  Projectile 


Variable 

Location  in 

Name 

Blank  Common 

Definition 

PRYBOT 

67 

The  number  of  cms.  from  the  bottom  of  th_  grid 

to  the  bottom  of  the  projectile. 

PRYTOP 

68 

The  number  of  cms.  from  the  bottom  of  the  grid 

to  the  top  of  the  projectile. 

PRXRT 

69 

The  number  of  cms.  from  the  axis  to  the  right 

of  the  projectile. 

VINI 

112 

Initial  axial  velocity  of  the  projectile. 

PROJU 

73 

Initial  radial  velocity  of  the  projectile. 

PROJI 

16 

Initial  specific  internal  energy  of  the 

projectile. 

RHINI 

111 

Initial  density  of  the  projectile. 

3*1.^»  Target 

Variable 

Location  in 

Name 

Blank  Common 

Definition 

TAYBOT 

86 

The  number  of  cms.  between  the  bottom  of  the 

grid  and  the  bottom  of  the  target. 

TAYTOP 

39 

The  number  of  cms.  between  the  bottom  of  the 

grid  and  the  top  of  the  target. 

TAXRT 

107 

The  number  of  cms.  between  the  axis  and  the 

right  of  the  target. 

TARGV 

52 

Initial  axial  velocity  of  the  target. 

TARGI 

72 

Initial  specific  internal  energy  of  the 

target. 

RHINIT 

15 

Initial  density  of  the  target. 
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3.1.5*  Sphere 


Variable 

Name 

Location  Jc. 

P-1  ink  Common 

Definition 

RADIUS 

162 

The  radius  (in  cms.)  of  the  sphere. 

YCENTR 

163 

The  number  of  cms.  from  the  bottom  of  the 

grid  to  the  center  of  the  sphere.  (Note:  The 

center  of  the  sphere  must  be  on  a  cell 
boundary  and  on  the  axis  of  the  grid. ) 

VINSPH 

102 

Initial  axial  velocity  of  the  sphere. 

SIESPH 

101 

Initial  specific  internal  energy  of  the 

sphere. 

RHOSPH 

100 

Initial  density  of  the  sphere. 

RHOOUT 

103 

Initial  density  of  material  in  the  outside 
part  of  a  cell  cut  by  the  sphere  boundary. 

3-1.6.  Filler 

Variable 

Name 

Loca^ion  in 
Blank  Common 

Definition 

RKOFIL 

51 

Initial  density  of  material  between  pro¬ 
jectile  and  target. 

3.1.7.  ?hj 

frical  Constants 

Variable 

Name 

Location  in 

Blank  Common 

Definition 

AMDM 

21 

The  lowest  compression  of  material  considered 

"solid."  If  p/p 0  s  AMDM,  and  material  is  cold 
(specific  internal  energy  <  ES*)  stresses 
and  pressure  are  zero. 


CZERO(Y0)  12 
5TK1(Y1)  11 
STK2(Y2)  28 
STEZ(Eq)  29 


Parameters  used  in  yield- strength  equation: 

Y  =  (Y0  +  YlM,  +  Y-i2)  •  (1  -  E/E0)  where 
p,  =  p/p0  -  1,  and  E  =  specific  internal 
energy. 

However, (l)  If  Y  <  0,  stresses  are  set  to  0. 
(2)  If  E  >  E0,  then  Y  -  0. 
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Variable  Location  in 
Name  Blank  Common 


Definition 


B3AR  149 


RHOZ  115 


ESA(a) 

ll6 

ESEZ(E0) 

117 

E3B(b) 

118 

escapa(a) 

H9 

ESESP (ES* ) 

120 

ESESQ(SSQ) 

121 

eses(es) 

122 

ESALPH(cr) 

123 

ESBETA(&) 

124 

escapb(b) 

125 

A  constant  used  to  approximate  sound  speed  for 
the  calculation  of  DT.  C  »  CQ  +  B  •  /? (K)  , 
where  CQ  =  /a/Pq  . 

The  normal  density  of  the  material.  This 
value  is  used  in  the  equation  of  state,  the 
calculations  of  PMEN  and  CQ,  the  strength 
calculations,  and  the  "slaving"  process. 

Gruneisen  ratio  at  high  energy, 

~  .5. 

A  constant  in  Gruneisen  ratio. 

A  constant  in  Gruneisen  ratio. 

Bulk  modulus. 

Heat  to  vaporize  naterial; 
must  be  larger  than  ESES. 

Used  to  test  whether  material 
is  "cold; "  usually  identical 
to  ESESP. 

Heat  to  bring  material  to 
vapor  temperature;  must  be 
smaller  than  ESESP. 

Usually  5* 

Usually  5* 

Usually  of  the  same  order  as  A. 


1  Equation  of 
State  con¬ 
stants,  See 
Ref.  4  or 
Section  4, 
PART  TWO 


3*1.8.  Calculatlonal  Constants 
Variable  Location  in 

Name  Blank  Conmon  Definition 

RHOMIN  138  The  smallest  density  a  cell  can  have  and  still 

influence  the  calculation  of  DT.  (Usually 
RHCMIN  -  RHOZ  *  10’3. ) 
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Variable 

Name 


Location  in 
Blank  Common 


Definition 


DMlN 


DTMIN 


EVAP 


ROEPS 


STAB 


2k  The  allowable  relative  error  in  the  energy 

sum.  The  error  is  the  difference  of  the 
current  totrl  energy  of  all  the  cells  and 
the  total  energy  computed  on  cycle  zero  but 
adjusted  for  energy  "evaporated*5  and  lost 
across  boundaries.  The  relative  error  is 
the  difference  divided  by  the  total  energy. 

If  it  exceeds  DMIN,  ERROR  is  called  and  the 
calculation  is  terminated. 

144  The  minimum  value  of  DT  (after  STAB  =  FINAL) 

for  the  calculation  to  continue.  DTMEN  may 
be  zero. 

75  This  variable  controls  the  "evaporation"  of 

mass.  If  p  <  EVA?  *  RHINI,  the  cell  mass  is 
evaporated.  The  mass,  energy  and  momentum 
of  evaporated  cells  are  accumulated  in  PH2 
and  printed  in  EDIT.  (Usually  EVAP  »  10  4.  ) 

110  The  "round-off  epsilon"  i_sed  in  setting  to 

zero  certain  calculated  differences  which 
could  be  due  simply  to  machine  rcvind-off . 
(Usually  ROEPS  =  10_5  or  10-6.  ) 

139  The  stability  fraction  vised  in  determining  DT. 

The  input  value  of  STAB  is  its  initial  value. 

If  FINAL  >  0.,  STAB  is  doubled  on  each  cycle 

until  it  equals  FINAL.  However,  if  FINAL  *  0., 

the  initial  value  of  STAB  is  used  throughout 

-3 

the  run.  STAB  is  usually  £  10  ,  but  when  all 

the  energy  is  initially  internal,  setting 

O 

STAB  ~  10”  is  recommended. 
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Variable 

Location  in 

Name 

Blank  Common 

Definition 

FINAL 

113 

FINAL  is  used  in  determining  DT.  If  FINAL  is 

>  0.,  then  it  is  the  largest  value  the  stabil¬ 
ity  fraction  (STAB)  will  have.  If  FINAL 
«  0.,  the  stability  fraction  will  have  the 
same  value  for  each  cycle.  (FINAL  is  usually 
~  .4.) 


J3TR 

25 

JSTR  (J  strength)  gives  the  value  of  12 
(active  grid,  J  direction)  at  which  stress 
calculations  (FH3)  are  turned  on  and  tensions 

are  allowed. 

N6 

56 

N6  specifies  the  J  index  of  the  cell  behind 
which  tensions  (negative  pressures)  are  to 
be  allowed.  If  n6  =  0.,  tensions  are  allowed 

everywhere. 

CYCPH3 

70 

CYCPH3  *  -1.  if  no  stress  calculation  is 

wanted.  Otherwise,  it  is  the  number  of  sub¬ 
cycles  of  TH3  per  time  step.  (Usually  about  4. ) 

NUMREZ 

12 

The  maximum  number  of  times  the  grid  will  be 

rezoned. 

NMTMAX 

85 

The  maximum  number  of  tracer  points  to  be 

used. 

Y2 

81 

Y2  =  -2.  if  tracer  points  are  to  be  calculated. 

Y2  =  0.  if  no  tracer  points  are  to  be  calculated. 

REZFCT 

71 

REZFCT  =  1.  if  rezones  are  allowed. 

REZFCT  =  0.  if  re zones  are  not  allowed. 

SS4 

130 

SS4  =  1.  if  a  rezone  is  to  be  forced  on  the 

second  cycle  of  a  run.  (Often  used  to  test 
the  setup  of  problems  to  be  rezoned. ) 
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IVARDX  33 


IVARDY  5^ 


Definition 

SN  =  0.,  if  negative  specific  internal  energy 
is  to  "be  set  to  zero. 

SN  =  1.,  if  negative  specific  internal  energy 
is  to  "be  left  along. 

CVIS  =  C.,  if  the  bottom  boundary  of  the  grid 
is  to  be  reflective. 

CVIS  =  -1.,  if  the  bottom  boundary  of  the 
grid  is  to  be  transmittive . 

INTER  =  0.,  gives  no  intermediate  prints. 

INTER  =1.,  gives  EDIT  prints  after  PHI  and 
PH3,  as  veil  as  CDT. 

INTER  =  7.,  gives,  in  addition  to  the  extra 
EDIT  prints,  details  of  PH2  calculations. 

INTER  =  99.,  gives,  in  addition  to  the  extra 
EDIT  prints,  details  of  PH3  stress  and  strain 
rates. 

CAUTION:  INTER  =  7.,  or  =  99.,  gives  many 
pages  of  output. 

IVARDX  =0.,  if  DX  is  constant  and  the  X  array 
is  to  be  calculated  from  the  value  of  DXF. 
IVARDX  =1.,  if  DX  varies  and  the  X  array  is 
included  in  the  input  deck. 

IVARDY  =0.,  if  DY  is  to  be  constant  and  the 
Y  array  is  to  be  calculated  fran  the  value 
of  DYF. 

IVARDY  =  1.,  if  DY  varies  end  the  Y  array  is 
included  in  the  input  deck. 


3.1. 9*  Output 


Variable 

Name 

JPROJ 

S, 

PRDEUT 

IPCYCL 

PRUM 

PRFACT 

NUMSCA 

NFRELP 


Location  in 

Blank  Common  Definition 

147  -  JPROJ  is  usually  assigned  the  value  of  J  at 

the  top  of  the  projectile.  In  EDIT,  JPROJ  is 
used  as  the  zero  in  calculating  the  crater 
depth  and  is  the  division  for  the  printout  of 
total  energy,  mass  and  momentum. 

45  The  number  of  seconds  between  EDIT  prints 
when  printing  on  time.  Otherwise  0. 

49  The  number  of  cycles  benween  EDIT  prints 

when  printing  on  cycles.  Otherwise  0. 

44  PRUM  is  the  time  or  cycle  at  which  the  EDIT 

print  interval  is  to  be  increased.  FRLIM  is 
multiplied  by  PRFACT  each  time  the  print 
interval  is  adjusted. 

46  The  factor  by  which  the  print  interval  3 
increased.  PRDELT  (or  IPCYCL)  and  PRUM  are 
multiplied  by  PRFACT  when  T  =  PRUM. 

43  NUMSCA  is  the  number  of  times  the  code  will 

increase  i,he  interval  time  (or  number  of 
cycles)  between  EDIT  prints. 

5  NFRELP  indicates  the  frequency  of  "long"  EDIT 

prints.  (A  "long"  print  gives  the  velocities, 
pressure,  mass,  energy,  density,  and  compres¬ 
sion  of  all  cells  in  the  active  grid;  the 
"short"  print  gives  this  information  only  for 
the  ceils  in  the  first  column  of  the  active 
grid. )  A  "long"  print  will  occur  every  NFRELP 
short  prints. 
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Variable  Location  in 
Na  e  Blank  Common 

NDUMP7  6 


NODUMP  96 


3.1.10.  Stopping 

Variable  Location  in 
Name  Blank  Common 


ICSTOP  7 


TSTOP  50 


Z(150)  150 


Definition 

NDUMP7  indicates  the  frequency  of  "tape  dumps,* 
where  most  of  Blank  Common  is  written  on  an  out¬ 
put  tape.  A  tape  dump  will  occur  every  NDUMP? 
EDIT  prints.  These  "tape  dumps"  are  used  for 
restarting  problems  and  for  making  automatic 
plots  of  tracer  points. 

NODUMP  =  1.  allows  the  user  to  pick  up  a  run 
at  some  intermediate  point  on  the  restart 
tape  without  writing  over  the  subsequent 
dumps  on  that  tape. 


Definition 

The  cycle  for  execution  to  stop  when  stopping 
on  cycles . 

The  value  of  T  for  execution  to  stop  when 
stopping  on  time  rather  than  cycles.  NOTE: 
This  card,  because  of  its  "l"  in  column  one, 
must  always  be  included  in  the  initial  input 
deck.  If  stopping  on  cycles  set  to  zero. 

Dummy  end  card.  Used  in  the  RPM  input  deck 
for  setting  up  problems.  (Do  not  include  this 
card  in  an  input  deck  when  restarting  a 
problem. ) 


3.2.  FORMAT  AND  ORDER  OF  OIL- RPM  INPUT  CARDS 

Except  for  the  ID  header  card,  all  RPM  input  cards  have  the  same  format 
and  are  normally  punched  on  7-vord  clvta  cards. 

The  RPM  setup  sheets  provide  the  information  to  be  punched  in  Col.  1, 
Cols.  2-6,  and  Col.  7  for  each  input  variable.  The  values  of  the  variables  . 
are  punched  in  the  seven  JJ-spscs  fields  in  Cols.  8-70.  These  values  must 
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be  punched  with  a  decimal  point  even  when  they  define  integer  variables. 

If  the  E-format  is  used,  the  exponent  must  be  right-adjusted  in  the  field. 
Only  those  variables  which  occur  in  consecutive  order  in  Blank  Common  can 


be  punched  on  the  same  card. 


col.  1 

Cols.  2-6 

Col.  7 

Cols.  8-16 

Cols.  17- 
25  etc. 

Punch  "l"  on 

N 

Number  of 

Z(N) 

z(n+i) 

first  and  last 

Location  in 

variables 

Value  of 

Value  of 

two  cards  of  deck. 

Blank  Common 

being 

variable 

variable 

(See  Setup  Sheet. ) 

of  variable 

defined  on 

equi- 

equi valenced 

Punch  "2"  on  all 
cards  defining 
integer  variables. 
Otherwise  no  punch. 

defined  in 
Cols.  8-l6. 

this  card. 

j 

valenced 
to  Z(N). 

1 _ 

to  Z(N+1). 

For  a  normal  setup  deck,  the  only  data  cards  which  must  be  in  a 
specific  order  are  those  listed  on  the  Setup  Sheet  with  a  "1"  in  column 
one,  and  they  must  be  the  first  and  the  last  two  cards  in  the  deck. 


3.3*  OIL-RPM  INPUT  FOR  "SPECIAL  SETUPS" 


The  properties  (density,  velocity,  internal  energy)  of  each  cell  are 
defined  by  the  subroutine  SETUP  according  to  the  input  parameters  associated 
with  the  sphere,  cylinder,  filler  and  target  (e.g.,  SIESPH,  VINI,  HHOFIL, 
TARGV).  The  RPM  "special  setup"  allows  the  user  to  assign  a  special  mass 

i.not  density),  velocity  or  internal  energy  to  specific  cells  in  the  grid. 

To  assign  special  properties  to  a  specific  cell  the  user  must  do  the 
following: 

1.  Fine  the  I  and  J  of  the  cell,  then  compute  its  K- index. 

(K  =  (J  -  1)*  B4AX  +1  +  1). 

2.  Find  the  location  in  Blank  Common  of  AMX(K),  U(k),  V(K),  and 
AIX(K),  whichever  is  being  specifically  defined.  (See  Table  3> 
page  2 6,  "Location  of  Arrays  in  Blank  Common.") 

3.  Using  the  format  of  the  other  RPM  input  cards,  punch  a  card  with 
the  location  and  value  for  each  property  being  assigned. 

Precede  these  input  cards  by  a  flag  card  which  has  a  "l"'in  column 
one  and  which  sets  Z(l64)  *  PK(l4)  =  1.  (See  Figure  2,  page  "  Flow 
Diagrams  of  INPUT,  CARDS  and  SETUP.")  Place  the  special  input  cards  in  the 
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RPM  input  deck  just  before  the  card  that  defines  ICST0P(Z(7) )»  The  flag 
card  (PX(l4)  =1.)  must  be  the  second  card  with  a  "1"  in  the  column  one  in 
the  input  deck. 

EXAMPLE:  Suppose  one  column  of  cells  in  the  target  next  to  the  axis 
is  to  be  empty.  The  target  is  to  range  from  J  **  5  to  J  *  8, 
and  IMAS  =  10.  (NOTE:  This  problem  requires  special  input 
because  RPM  places  all  packages  next  to  the  axis  of  the  grid. ) 


AXIS 


EMPTIED 

CELLS 


J«8 


J>9 


XMAX  «  10 


1.  Compute  the  K- index  of  the  empty  cells. 


I  =  1, 

It 

K  = 

4*10  +  1  + 

1  =  42 

1  =  1, 

J  =  6 

K  = 

S2 

1  =  1, 

J  =  7 

K  = 

62 

1  =  1, 

J  =  8 

K  = 

72 

Find  the 

location  in  31ank 

Common 

of  members 

of  the  AMX  array 

which  store  the  masses  of  these  cells.  Table  3  indicates  that  482  is  the 
location  of  AMX  (l)  in  Blank  Common. 
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Location  in  Blank  Common 


Variable  Name 


AMX(42)  523 
AMX(52)  533 
AMX(62)  543 
AMX(72)  553 


3.  The  input  deck  would  be  organized  as  follows: 


Description 
of  card 

Col. 

1 

Col. 

2-6 

Col. 

7 

Col. 

8-16 

ID  CARD 

PK(1) 

1 

151 

1 

IMPACT 

3.2 

Z(1)=PR0B 

blank 

1 

3.2 

• 

• 

• 

• 

• 

• 

• 

• 

• 

♦ 

• 

• 

• 

• 

• 

NODUMP 

2 

96 

1 

0. 

PK(l4) 

1 

164 

1 

1. 

AMX(42) 

blank 

523 

1 

0. 

AMX(52, 

blank 

533 

1 

0. 

AMX(62) 

blank 

543 

1 

0. 

AMX(72) 

blank 

553 

1 

0. 

ICSTOP 

2 

7 

1 

0. 

TSTOP 

X 

50 

1 

1.-06 

Dummy  End 

1 

150 

1 

0. 
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TABLE  3 


LOCATION  OF  ARRAYS  IN  BLANK  COMMON* 


Name  of  Array 

Location  of  First  Me 

Z 

1 

PK 

151 

YY  Note:  YY(l)  =  Y(0) 

1 66 

XX  Note:  XX(l)  =  X(0) 

270 

DDX  Note:  DDX(l)  =  DX(O) 

324 

DDY  Note:  DDY ( 1 )  =  DY(O) 

378 

AMX 

482 

AIX 

2984 

U 

5486 

V 

7988 

P 

10490 

TAU 

12992 

JPM 

13044 

UL 

13096 

PL 

13300 

XP 

13504 

YP 

14830 

CMXP 

16156 

CMYP 

16161 

These  location  numbers  should  not  be  used  if  the  dimension  of  any 
array  in  Blank  Common  is  changed. 


4.  SAMPLE  PROBLEM 


The  impact  of  an  aluminum  sphere  on  a  target  of  like  material  was 
described,  in  an  earlier  report,  ^  and  the  setup  of  the  problem  will  be 
described  in  this  section  as  an  example.  The  sphere  diameter  was  .4-763  cms 
(3/l6  in.),  and  its  velocity  was  7*35  km/sec.  The  zoning  was  chosen  so 
that  the  sphere  radius  contained  exactly  6  cells,  the  free  surface  of  the 
target  was  16  zones  above  the  bottom  of  the  grid,  and  the  cells  were  square. 
It  was  found  that  after  16  microseconds  the  velocities  were  down  to  a  value 
where  the  subsequent  material  motion  would  be  negligible.  The  grid  was 
rezoned  twice  during  the  computation.  About  two  hours  of  computer  time  and 
about  450  cycles  were  required  to  complete  the  problem. 

Details  of  the  setup  are  given  by  the  OIL-RPM  Setup  Sheets  which  list 
the  appropriate  values  for  the  input  parameters  and  describe  the  format  of 
the  data  cards.  Also,  the  main  section  of  the  printed  output  are  illus¬ 
trated  and  briefly  discussed  in  addition  to  the  control  cards  for  the 
UNIVAX  1108. 
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Oil/- RPM  SETUP  SHEET- -X  AND  Y  ARRAYS* 


♦These  location  numbers  ^Cols.  2-6)  must  be  changed  IT  the  dimension  of  FK>  or  YY  is  changed. 


1.1.  OIL-RPM  Output 


The  pages  of  OIL-RPM  output  which  follow  were  produced  by  the  sample 
problem,  "Standard  Crater, "  described  above.  The  printed  headings  make  most 
of  the  listing  self-explanatory.  Sections  needing  further  description  are 
numbered  in  the  listing  and  discussed  below. 

1.  The  first  few  pages  of  the  output  for  a  setup  run*  display  the 
input  deck  and  describe  the  initial  conditions  of  the  problem. 
(Each  time  the  CARDS  routine  is  called  "INPUT  CARDS"  is  printed. ) 

2.  When  a  sphere  is  placed,  SETUP  assures  that  the  value  of  YCENTR  is 
on  a  c  _1  boundary  and  prints  the  input  and  adjusted  values  of 
YCENTR. 

3.  On  every  cycle  subroutine  CUT  points  the  value  of  T,  the  time,  and 
DT,  the  time  step.  The  integers  following  "CDT"  in  the  printout 
are  the  I  and  J  of  the  cell  c'ontrolling  the  time  step.  MAXCUV 
represents  the  maximum  sound  speed  or  velocity  in  the  active  grid. 
Likewise,  MAXUV  represents  the  maximum  velocity.  UMIN  and  PKIN 
are  velocity  and  pressure  cutoffs,  respectively,  used  in  MAP  and 
PH2. 

k.  The  first  page  printed  by  EDIT  gives  the  total  energies,  mass  and 
momenta  of  the  cells  above  the  JPROJ  row  and  of  the  cells  below 
and  in  the  JPROJ  row.  (JPROJ- is  an  input  parameter,  usually  the  J 
of  the  top  row  of  the  projectile  package. ) 

5.  On  each  cycle  EDIT  calculates  the  relative  error  in  the  total 
energy  sum.  On  print  cycles  EDIT  prints  the  maximum  error  cal¬ 
culated  and  the  number  of  the  cycle  in  which  the  maximum  error 
occurred. 

6.  The  total  work  done  due  to  stresses  calculated  in  PH3  is  printed 
-under  "PLASTIC-WORK. " 

7.  Also  printed  is  a  running  total  of  the  mass,  energy,and  axial  id 
radial  momentum  lost  when  material  crosses  a  transmittive  boi  adary 
or  is  "evaporated"  in  PH2, 


*For  a  restart  run  only  the  input  deck  is  printed. 
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8.  The  "J  OF  PRESSURE  MAXIMUM"  describes  the  shock  front  by  giving 
the  location  of  the  peak  pressure  in  each  column. 

9.  The  tracer  point  coordinates  are  printed  in  centimeter  units.  The 
I  and  J  of  the  cell  in  which  a  tracer  point  originated  is  also 
printed.  This  enables  the  user  to  follow  the  movement  of  a  given 
tracer  point.  However,  if  the  mass  of  a  cell  is  "evaporated"  the 
coordinates  of  the  tracer  points  in  that  cell  are  set  to  zero  and 
thereafter  are  not  printed  out. 

10.  The  range  of  values  assigned  to  the  symbols  on  the  contour  maps 
are  adjusted  as  the  calculation  proceeds.  Therefore,  a  given 
symbol  in  the  compression  map,  for  instance,  does  not  represent 
the  same  compression  from  one  print  to  the  next.  A  negative 
pressure,  velocity,  or  internal  energy  is  denoted  by  a  symbol 
representing  its  absolute  value  and  preceded  by  a  minus  sign. 

11.  The  crater  depth  is  measured  from  JFROJ.  After  a  crater  is  formed, 
the  negative  values  for  the  crater  depth  will  describe  the  crater's 
"lip".  The  volume  of  the  crater  is  printed  along  with  the  volume 
of  a  hemisphere  of  radius  equal  to  the  crater's  depth  in  column 
one. 

12.  The  J- index,  radial  velocity,  axial  velocity,  pressure,  mass, 
density,  specific  internal  energy,  compression,  and  distance  (in 
cms.)  from  the  bottom  of  the  grid  are  printed  for  non-empty  cells. 
The  "long"  EDIT  print  lists  these  properties  for  every  column  of 
the  active  grid,  whereas  the  "short"  EDIT  print  describes  the  non¬ 
empty  cells  in  column  one  only. 

13.  Several  error  conditions  are  tested  for  during  execution,  and  when 
one  is  detected,  subroutine  ERROR  is  called.  ERROR  in  turn 
identifies  the  error  test,  prints  the  entire  Z- array,  and  calls 
EDIT  to  do  a  long  print  and  tape  dump  before  stopping. 
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*♦*  EKKOk  tXlT  -  SEE  STAfFMEur  NUMoEK  fb  IN  CDT 


1=  8  *->-  lo 

K=7o5 

2-uLoCn 

KEAl  F uK  'A  I 

INTcGER  format 

I 

211) 

2(1) 

1 

.13/350t02 

1783195782° 

2 

-. 10o00u+ui 

-17381195770 

3 

.OOoOOO 

0 

4 

.OQoQUO 

0 

b 

.b0c<000-3a 

b 

6 

« 80u00u-3b 

JL 

7 

.OOoOOO 

0 

a 

.314189+01 

17553718998 

9 

.OUuQOO 

0 

10 

.OOuOOu 

0 

11 

.240000+11 

2l97l259b64 

12 

•  b(!o000-38 

2 

13 

.OOOOOO 

0 

14 

.OO0O0O 

0 

15 

.^7o0O0+01 

I7b3b901b0b 

16 

.OOoOOO 

0 

17 

.000000 

0 

18 

.16o740+G1 

1742b9b42H 

19 

,8OuOO0“3d 

1 

20 

.bCoOOO-38 

2 

21 

.97o0uo-00 

173lU0b03flO 

22 

.OOoOOO 

0 

23 

.OOoOOO 

0 

24 

.10oo0o-02 

16040629108 

25 

, bOoOOO-36 

28 

26 

.OOuOOO 

0 

27 

— « 10oQOO+Oi 

-17301195770 

28 

.410000+11 

22091785517 

29 

»70o000+10 

21716429208 

30 

-.500000-36 

-1 

31 

.OOoOOO 

0 

32 

.  OQoQOO 

0 

33 

.bOoOOO-38 

42 

34 

. 50o0OC“36 

43 

35 

,60o000-3b 

54 

36 

.60o0O0-3a 

55 

37 

•540000-38 

2269 

30 

.54o000-36 

2270 

39 

.OOoOOO 

0 

40 

.OOoOOO 

0 

41 

.OOoOOO 

0 

42 

.23V0O0+1O 

2i5495239fiO 

43 

,5uuOOO-3b 

10 

44 

.10u000-o5 

1470010109O 

40 


4.2.  UNIVAC  1108  CONTROL  CARDS 


Program  Tape 
Restart  Tape* 


7  ASG  P  =*  1184 
7  ASG  7  =  2213 
7  XQT  CUR 
IN 

TRI  P 
"too 

7P  HDG  STANDARD  CRATER 

7  XQT  RPK 


,  Input  deck 

06 


STANDARD 

151 

CRATER 

1 

13-735 

• 

• 

• 

• 

• 

• 

65 

i 

1.0 

• 

• 

■> 

• 

50 

1 

1.0 

- 

*  Can  assign  a  drum  area  for  tape  dumps  instead  of  a  tape  by  using: 
7D  ASG  7  »  100000 


4l 


5.  RESTART  OF  PROBLEMS 


Periodic  > . iy  during  a  calculation  RH-  writes  on  tape  the  problem  para¬ 
meters  and  the  current  state  of  the  mater i  ■  i  in  each  cell.  By  reading  this 
tape  the  user  can  "restart"  and  continue  a  -nlculation  from  an  intermediate 
point.  Because  the  initial  conditions  a r<*  saved  on  cape,  SETUP  is  not  called 


and  the  following  three  cards  are  the  only  ones  which  must  be  in  the  restart 
input  deck: 


Description 

Col. 

Col. 

Col. 

Col. 

Col. 

Col. 

of  Card 

1 

2-6 

7 

8-16 

17-25 

26-34 

ID  CARD 

IMPACT 

PK(1),PK(2), 

PK(3) 

1 

151 

3 

3.2 

88. 

-1. 

TSTOP 

1 

50 

1 

1.-06 

PK(l)  *  The  same  problem  number  used  when  the  problem  was  initially 
setup.  (NOTE:  This  can  be  any  number  between  00.0000  and 
99-9999- ) 

PK(2)  «  The  restart  cycle  number.  The  problem  can  be  restarted  on  any 

cycle  which  is  marked  as  a  tape  dump  cycle  in  the  printed  output. 

PK(3)  *  The  restart  flag.  If  it  is  -1.  EDIT  makes  a  long  print  of  the 
restart  cycle.  However  the  user  may  wish  to  avoid  making  a 
long  print  on  the  restart  cycle.  Ee  can  do  this  by  setting 
PK(3)  -  -2. 

T3T0P  =  The  new  time  at  which  execution  will  stop. 

Other  variables  besie  •  -  TSTOP  may  be  redefined  when  restarting  a  problem. 
The  copy  of  the  "Setup  Sheet  for  OIL-RPM  Restarts"  on  page  44  lists  those 
variables  most  likely  to  be  redefined  at  en  intermediate  point  in  the  cal¬ 
culation. 

The  cards  in  a  restart  input  deck  can  be  in  any  order  as  long  as  the 
first  card  is  the  ID  card,  the  second  card  defines  PK(l),  PK(2)  and  PK(31 
and  has  a  "1"  in  column  one,  and  the  last  card  has  a  "1"  in  column  one. 
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WvDa>''iC'ir.  -p  cx  ru  »- 


RPM 


DIMENSION  AMX(2502) »AIX(2502) »U(2502)  rV(2502) 

X(52)  »XX(54)  »TAU{52)  .JPM(52) 


.P(2502) 


Y(i02)  » YY (104)  #FLEFT(10 

GAMCUC2) . 

PK ( 15) .  2(150)  » 

XP(26»5I) . YP(26.51) » 

PL(204)  »UL(204)  #PR(2Q4) 

RSN(52)»  RST (52) » 

CMXP(5)  »CMYP(5)  »IJ(5) 

DX ( 52)  . DDX(54)  »DY(102) 

SNB ( 52 )  fSTB:52)  »UK(52»3) 
***  DIMENSIONED  ARRAYS 
***  Z-BLOCK  IS  SAVED  ON  TAPE. 


»FLEFT(102)»  YAMCU02)#  SIGC<102)* 


r J«(5)  . 

»DDY(104)  » 

.VK(52.3)  »RH0(52.3) 


COMMON 

2 

COMMON 

PK 

COMMON 

YY  . 

XX 

COMMON- 

DDX» 

ddy 

COMMON 

AMX. 

AlX. 

Ut 

V. 

p 

COMMON 

TAU. 

UPM 

COMMON 

UL  » 

PL 

COMMON 

XP  » 

Yp» 

CMXP.  CMYP 

***  NON-D 1 ,  *ENSI ONED 

VARIABLES 

COMMON 

AID 

» AMMV 

» AMMY 

.AMPY 

1AMVT 

.  DEL :  l 

.deler 

.DELET 

.delm 

.dtodx 

2E 

.ERDUMP 

.1 

.13 

»IWS 

3LL 

.MD 

.ME 

»MZT 

.NERR 

»NK 

4NR 

»NRZ 

.nulle 

.PIOTS 

»SIEM.(N 

.SNR 

5SUM 

.TESTRH.TWOpI 

»URR 

»ws 

» WSA 

30 
40 
50 
60 
70 
80 
90 
100 
110 
120 
130  - 
140 
150 
160 
170 
180 
190 
200 
210 
220 
230 
240 
250 
260 


6WFLAGL.  fc'FLAGP 
COMMON  LAST 

**»  THE  FOLLOWING  EQUIVALENCES  MAKE  AVAILABLE 
X(Q)»  Y(Q)»  OX(Q)»  DY(0) 

EQUIVALENCE  (XX(2)»  X(l)).  (YY(2)»  Y(D) 

EQUIVALENCE  \DDX(2)»  DX(1))»  (DDY(2).  DY(1) ) 

***  SPECIAL  EQUIVALENCES  FOR  PH2  ONLY 


.AMUR  » AMUT 

. AMVR  » 

270 

.DXYMIN.EAMMP 

.EAMPY  . 

280 

.K  »KA 

.KB  t 

290 

.nprint. 

300 

»SNT  .STR 

.SOLID  » 

310 

»WS3  »WSC 

.WFLAGFr 

320 

.  330 

.. 

335 

equivalence 


(UL.FLEFT) » 
(PL.GAMC.PR)» 


(UL( 103) . YAMC) » 
(PL<l03)»SIGC) 


***  SPECIAL  EQUIVALENCES  FOR  PH3  ONLY 


EQUIVALENCE 


(UL.RSN) » 
(PL.RST) > 
(P(157) » VK) » 
(P(365) .STB) . 


( P » UK ) . 
(P(313) »SNB) » 
(P(417)»RH0) 


***  SPECIAL  EQUIVALENCES  FOR  EDIT 
EQUIVALENCE  (PR(1).  IU)  *  (PR<6).  UK) 

***  2-STORAGE  equivalences 


ofsr»r>or>oo 


EQUIVALENCE 

(Z( 

1) 

.PROB  ) 

.  (Z( 

2) 

.CYCLE 

)  9 

580 

590 

1(Z(  3)»0T 

)#(Z( 

4) 

»  NUMSP 

) » 

(Z( 

5). 

NFRELP) . 

czc 

6)  . 

NDUMP7) 

9 

600 

2(21  7) » ICSTOP 

).(Z( 

8) 

»PI0Y 

). 

(Z( 

9) 

.TOPmu  ) 

czc 

10) 

.rtmu 

) . 

610 

3(2(  11).STK1 

).(Z( 

12) 

.NUMREZ). 

(Z  ( 

13) 

»eth  ) 

(Z( 

14) 

»UN14 

) . 

620 

4(2(  15) .KHINXT 

).(Z( 

16) 

.PROJI 

). 

(Z( 

17) 

.UNI  7  ) 

cz 

18) 

.XMAX 

) . 

630 

5C2(  19) »NZ 

)»(Z( 

20) 

.NREZ 

). 

(Z( 

21) 

.AMOM  ) 

(Z( 

22) 

.  UVMAX 

) . 

640 

t»(Z(  23J.UN23 

) .  (Z( 

24) 

»0MIN 

). 

( z 

25) 

» JSTR  ) 

czc 

26) 

»DTNA 

). 

650 

71 Z(  27) .  CVIS 

)»(Z( 

28) 

»STK2 

). 

(Z( 

29) 

»STEZ  ) 

(Z( 

30) 

»nc 

). 

660 

tt(Z(  31).UN31 

).(Z( 

32) 

»NRC 

) . 

(Z( 

33) 

.IMAX  ) 

czc 

34) 

.  IMAXA 

). 

670 

9(Z(  35) »  JMAX 

).(Z( 

36) 

. JMAXA 

) » 

(Z  ( 

37) 

. KMAX  ) 

(Z( 

38) 

.kmaxa 

) 

680 

EQUIVALENCE 

690 

1(Z(  391r #uOTM 

).(Z( 

40) 

.BOTMV 

). 

(Z( 

41) 

.NUMSPT) 

czc 

42) 

.CZERO 

). 

700 

2 (2(  43) . NUMSCA 

).(Z( 

44) 

.PRL1M 

). 

(Z( 

45) 

.PRDELT) 

(Z( 

46) 

.PRFACT) 

710 

EQUIVALENCE 

720 

1(Z(  47) .11 

).(Z( 

48) 

.12 

) . 

czc 

49) 

.IPCYCL) 

czc 

50) 

.TSTOP 

). 

730 

2(Z(  51) .KHOF1L 

).(Z( 

52) 

.targv 

) . 

(Z( 

53) 

»N3  ) 

(Z( 

54) 

» IVARDY) . 

740 

3(Z(  55) » VT 

) .  (Z( 

56) 

»N6 

). 

(Z( 

57) 

»RTM  ) 

czc 

58) 

►  RTMV 

) . 

750 

4(Z(  59)  . UN59 

)#(Z( 

60) 

»N10 

) . 

(Z( 

61) 

.Nil  ) 

(Z( 

62) 

.gamma 

) . 

760 

5(Z(  63) »  TOPM 

)»(Z( 

64) 

.botmu 

) . 

(Z( 

65) 

»SN  ) 

(Z( 

66) 

» TOPMV 

). 

770 

b(Z(  67J.PRY0OT 

)  .  (Z( 

68) 

.PRYTOP) . 

(Z( 

69) 

.PRXRT  ) 

czc 

70) 

.CYCPH3) » 

780 

7tZ(  7D.KEZFCT 

)»(Z( 

72) 

.TAR6I 

). 

(Z( 

73) 

.PROJU  ) 

czc 

74) 

.BBOUNO) . 

790 

8(Z(  75) . EVAP 

).(Z( 

76) 

»ECK 

) . 

(Z< 

77) 

.NECYCL) 

(Z( 

78) 

»II 

). 

800 

9(Z(  79) .  JJ 

).(Z( 

80) 

.NMP 

). 

(Z( 

81) 

»Y2  ) 

(Z( 

82) 

.EZPH1 

) 

810 

equivalence 

820 

1(Z(  b3) » 1VAROX 

)#(Z( 

84) 

.T 

). 

(Z( 

85) 

.NMPMAX) 

(Z( 

86) 

.PMIN 

) . 

830 

2(z(  t*7)  r inter 

) ;  (Z( 

88) 

.TAYBOT) » 

(Z( 

89) 

.TAYTOP) 

czc 

90) 

.iemap 

)* 

840 

3(Z(  91). MC 

).(Z( 

92) 

.MR 

). 

(Z( 

93) 

.MZ  ) 

(ZC 

94) 

.MB 

) 

850 

equivalence 

860 

KZ(  95).KEZ 

)  .  (Z( 

96) 

.NODUMP) » 

(Z< 

97) 

.UN97  ) 

.  (Z( 

98) 

»UN98 

) . 

870 

2(Z(  99) »UN99 

) . (Z(100) 

.evapm 

). 

(Z(101) 

.EVAPEN) 

. (Z( 102) 

.EVAPMU) . 

880 

3(Z(103) .EVAPMV 

) » (Z(104) 

.EZPH2 

). 

(Z(105) 

.SNL  ) 

. (Z ( 106) 

.STL 

) . 

890 

4 (Z ( 107) . TAXRT 

) . (Z (108) 

» IDNMAP) . 

(Z(109) 

.IPRMAP) 

. (Z(110) 

.ROEPS 

) . 

900 

5(Z(111) .RHINI 

) . (Z(112) 

»VINI 

). 

(Z( 113) 

.FINAL  ) 

. (Z ( 114) 

. IVMAP 

). 

910 

6(Z(115) »RHOZ 

) . <Z(116) 

»ESA 

). 

(Z(  117) 

. ESEZ  ) 

. ( Z ( 118) 

»ESB 

). 

920 

7(Z(119) .ESCAPA 

) p  CZ( 120) 

.ESESP 

) . 

(Z(121) 

►ESESQ  ) 

. (Z( 122) 

.ESES 

). 

930 

81Z1123) .ESALPH 

) . (Z ( 124) 

»ESBETA) » 

(Z( 125) 

.ESCAPB) 

. (Z( 126) 

.IUMAP 

) . 

940 

9(Z( 127) »SS1 

).(Z(128) 

»SS2 

). 

(Z( 129) 

.UMIN  ) 

. (Z(130) 

»SS4 

) 

950 

EQUIVALENCE 

960 

1(Z(131> .PRTIME 

) . (Z ( 132) 

.EOR 

) . 

(Z(133) 

.EOT  ) 

. (Z( 134) 

»EOB 

). 

970 

2(Z(135) »EMOR 

) . (ZC136) 

.OXF 

) . 

(Z ( 137) 

»DYF  ) 

. (Z( 138) 

.RHOMIN) » 

980 

3(2(139) .STAB) » 

( Z ( 140 ) . 

XIENRG) 

. 

(Z(141) 

.XKENRG) 

.  (Z(142) .XTENRG) , 

990 

4<Z(143) .STT 

) » ( Z ( 144 ) 

.DTMIN 

. 

(Z( 145) 

.TRNSFC) 

. (Z( 146) 

.EMOT 

) . 

1000 

5(Z(147) » JPROJ 

) . (2(148) 

»cnaut 

)  . 

<Z(149) 

. BBAR  ) 

. CZC150) 

.EMOB 

) 

1010 

1020 

. . . . . .  1030 

1040 

END  OF  COMMON  1050 

1060 
1070 
1080 
1081 
1082 

1083 

1084 

1085 

1086 


***  INXAL1ZE  BLANK  COMMON 
LAST  =  1 
IQ  s  0 
5  IQ  =  1QU 
ZUU)  =  0. 

IF(LAST.NE.Q)  00  TO  5 


X' 


vr 


o  o  ooo 


10  CALL  INPUT  1090 

20  call  cdt  mo 

CALL  EDIT  1130 

C  *♦*  ASK  WFL*GL  WHETHER  THIS  IS  THE  LAST  CYCLE.  1140 

C  wFLAGL  IS  SET  IN  EDIT.  1145 

IF  ( WFLAGL. GT.O.)  GO  TO  40  1150 

CALL  PHI  1160 

***  NPRINT=1  ON  EDIT  PRINT  CYCLES.  1162 

INTER. NE.O  WHEN  INTERMEDIATE  EDIT  PRINTS  ARE  WANTED.  1164 

IF  (INTER. NE.O. AND. NPRINT.EQ.l)  CALL  EDIT  1170 

***  CYCPH3=-i.  WHEN  PHASE  3  IS  NOT  USED.  OTHERWISE »  *  1172 

CYCPH3=NUmBER  OF  TIMES  PHASE  3  CALCULATIONS  ARE  1174 

-  SUBCYCLED.  1176 

IF  (CYCPH3.EQ. (“1. ) )  GO  TO  30  1180 

Call  ph3  1190 

IF  (INTER. NE.O. AND. NPRINT.EQ.l)  CALL  EDIT  1200 

30  CALL  PH2  1210 

GO  TO  20  1220 

40  CALL  EXIT  1230 

END  1240' 


\ 


subroutine  input 


DIMENSION  AMX(2502) pAIX(2502) rU(2502)  »V( 2502)  ?P(2502)  p 

X(52)  #XX( 54)  »TAU(52>  pJPM(52)  p 

Y (102)  pYY (104)  pFLEFT (102) t  YAMC(l02)p  SIGC(102)p 
GAMC ( 102) p 

PK ( 15) t  2(150)  p 
XP(26p51) pYP(26p51) t 
PL(204)  pUL(2G4)  pPR(2Q4)  p 

RSN(52) p  RST (52)  p 

CMXP (5)  #CMYP(5)  #IJ(5i  pUK<5)  p 

0X(52)  pQDX(54)  pDY(102)  pDDY(104)  p 

SNB(52)  p STB (52)  pUK(52p3)  pVK(52p3)  pRH0(52p3) 

***  DIMENSIONED  ARRAYS 
***  2-BLOCK  IS  SAVED  ON  TAPE. 


•P(2502) 


»JK(5)  p 
pDDY (104)  p 
pVK(52p3)  pRH0(52p3) 


INF  10 
i  INP  20 
INP  30 
INP  40 
INP  50 
INP  60 
INP  70 
INP  80 
INP  90 
INP  100 
INP  110 
INP  120 
INP  130 
INP  140 
INP  150 
INP  160 


COMMON  2 

INP 

170 

COMMON  PK 

INP 

180 

COMMON  YY  p 

XX 

INP 

190 

COMMON  DDXp 

ddy 

INP 

200 

COMMON  AMXp 

AIX* 

Up 

V  p  P 

INP 

210 

COMMON  TAUp 

JPM 

INP 

220 

COMMON  UL  t 

PL 

INP 

230 

COMMON  XP  p 

YP# 

CMXPp  CMYp 

INP 

240 

***  NON-DIMENSIONED 

VARIABLES 

INP 

250 

COMMON 

AID 

pAMMV 

jAMMY  pAMPY 

pAMUR  pAMUT 

pAMVR 

p 

INP 

260 

1AMVT  pDELEB 

rDELER 

pDELET 

pDELM  pOTODX 

pDXYMINpEAMMP 

pEAMPY 

p 

INP 

270 

2E  pERDUMPpI 

p  13 

pIWS  pJ 

pK  pKA 

pKB 

p 

INP 

280 

3LL  pMD 

»ME 

pMZT 

pNERR  pNK 

pNPRINTp 

INP 

290 

4NR  pNRZ 

»NULLE 

pPIDTS 

pSIEMIN'SNR 

pSNT  pSTR 

p SOLID 

p 

INP 

300 

5SUM  pTESTRHpTWOPI 

pURR 

pWS  p  VISA 

p MSB  p WSC 

pWFLAGF* 

INP 

310 

6WFLAGL » WFLAGP 

***  THE  FOLLOWING  EQUIVALENCES  MAKE  AVAILABLE 
X(Q)p  Y(0) »  DX(0) p  DY(0) 

EQUIVALENCE  (XX (2) p  X(l) ) p  ( YY (2)  r  Y(D) 

EQUIVALENCE  (DDX(2)p  DX(1))»  (DDY(2)»  DY(1) ) 

***  SPECIAL  EQUIVALENCES  FOR  PH2  ONLY 


EQUIVALENCE 


(ULrFLEFT) t 
(PL'GAMCpPR) » 


(UL(103)»YAMC)» 
(PL (103) pSIGC) 


***  SPECIAL  EQUIVALENCES  FOR  PH3  ONLY 


EQUIVALENCE 


(ULpRSN) p 
(PLpRST) p 
(P(157) p  VK) » 
(P(365)»STB)» 


(PpUK) p 
(P(313) rSNB) p 
(P(417) pRHO) 


***  SPECIAL  EQUIVALENCES  FOR  EDIT 
EQUIVALENCE  (PR(i)p  IJ) »  (PR(6)p  JK) 


*♦*  2-STORAGE  EQUIVALENCES 


EQUIVALENCE 


(2(  1) pPROB  >p(Z(  2) pCYCLE  )p 


INP  320 
'INP  330 
INP  340 
INP  350 
INP  360 
INP  370 
INP  380 
INP  390 
INP  400 
INP  410 
INP  420 
INP  430 
INP  440 
INP  450 
INP  460 
INP  470 
INP  480 
INP  490 
INP  500 
INP  510 
INP  520 
INP  530 
INP  540 
INP  550 
INP  560 
INP  570 
INP  580 
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ooooonon 


C 

C 

c 


1(Z(  3)  »DT  ) 

»(ZC 

4) 

» NUMSP 

) . 

IZ( 

5)  » 

NFRELP) . (Z( 

6) . 

NDUMP7) . 

INP 

590 

2(Z(  7 ) » ICSTOP) 

»(Z( 

8) 

»PIDY 

)  » 

(Z( 

9) 

.TOPMU  i.(Z( 

10) 

.  rtmu 

) . 

INP 

600 

3 ( Z (  11) .STKi  ) 

.  (Z( 

12) 

.NUMREZ) » 

(Z( 

13) 

.ETH  >»(Z( 

14) 

.  UN14 

). 

INP 

610 

4(Z(  1S)»RHINIT) 

.  (Z( 

16) 

.PROJI 

)  » 

(Z( 

17) 

UN17  )»<Z( 

18) 

.xmax 

). 

INP 

620 

b  ( Z  (  19) . NZ  ) 

.  (Zi 

20) 

.  NREZ 

)  . 

(Z( 

21) 

»AMDM  ).(Z( 

22) 

.UVMAX 

) . 

INP 

630 

6 ( Z  C  23).UN23  ) 

.  (z( 

24) 

.DMIN 

) . 

(Z( 

25) 

» JSTR  )»(Z( 

26) 

.  dtna 

) . 

INP 

640 

7 (Z (  27) .CVIS  ) 

.  (z< 

28) 

»STK2 

)  # 

(Z  ( 

29) 

.STEZ  ).(Z( 

30) 

»nc 

) . 

INP 

650 

S(Z(  31) »UN3i  ) 

.( Z( 

32) 

.  NRC 

) » 

(Z( 

33) 

»IMAX  )»(Z( 

34) 

» IMAXA 

). 

INP 

660 

9(Z(  3S) . JMAX  ) 

.  IZ< 

36) 

.  JMAXA 

) » 

(Z( 

37) 

.KMAX  )»(Z{ 

38) 

.K1AXA 

) 

INP 

670 

equivalence 

INP 

680 

1(Z(  39) » bOTM  ) 

.(Z( 

40) 

.30TMV 

)  # 

(Z( 

41) 

rNUMSPT) » (Z( 

42) 

.CZERO 

) . 

INP 

690 

2(Z(  43) .NUMSCA) 

tlzi 

44) 

.PRLIM 

) » 

(Z( 

45) 

.PRDELT) » (Z( 

46) 

.PRFACT) 

INP 

700 

EQUIVALENCE 

INP 

710 

1(Z<  47 ) .11  ) 

.  ( z  ( 

48) 

» 12 

)  ♦ 

(Z( 

49) 

.IPCYCL) » (Z( 

50) 

.TSTOP 

) . 

INP 

720 

2(Z(  51 ) .RHOFIL) 

*(Z( 

52) 

#  TARGV 

) » 

(Z( 

53) 

rN3  ) » (Z( 

54) 

. IVARDY) » 

INP 

730 

3(Z(  55) . VT  ) 

.(Z( 

56) 

.N6 

)  t 

(Z( 

57) 

rRTM  )»(Z( 

58) 

»rtmv 

). 

INP 

740 

4 (Z(  59) .UN59  ) 

»(z< 

60) 

»N10 

)  t 

(Z( 

61) 

f Nil  )»(Z( 

62) 

.GAMMA 

). 

INP 

750 

5CZ(  63) » TOPM  ) 

•  (Z( 

64) 

.dOTMU 

)  * 

(ZC 

65) 

.SN  ).(Z( 

66) 

.TOPMV 

). 

INP 

760 

6(Z(  67) .PRYBOT) 

.(Z< 

68) 

♦PRYTOP) . 

(Z( 

69) 

.PRXRT  ) . ( Z ( 

70) 

.CYCPH3) » 

INP 

770 

7(Z(  71) .REZFCT) 

.  (z  ( 

72) 

.TARGI 

). 

(Z( 

73) 

.PROJU  )#(Z( 

74) 

.8BOUND) t 

INP 

780 

8(Z(  75) » EVAP  ) 

.(Z( 

76) 

.ECK 

)  . 

(Z( 

77) 

.NECYCL) r (Z( 

78) 

»II 

). 

INP 

790 

9(Z(  79)  . JJ  ) 

.(Z( 

80) 

»NMP 

)» 

(Z( 

81) 

»Y2  ).(Z( 

82) 

.EZPHl 

) 

INP 

800 

EQUIVALENCE 

INP 

810 

1(Z(  83) . IVARDX) 

» <z( 

84) 

»  T 

)  t 

(Z( 

85) 

.NMPMAX) t  (Z( 

86) 

»PMIN 

) . 

INP 

820 

2(Z(  87) r INTER  ) 

.(Z< 

38) 

.TAYBOT) » 

(Z( 

89) 

.TAYTOP) » (Z( 

90) 

.iemap 

). 

INP 

830 

3(Z(  91). MC  ) 

.(z( 

92) 

»MR 

) . 

(Z( 

93) 

.MZ  )»(Z( 

94) 

.MB 

) 

INP 

840 

equivalence 

INP 

850 

1(Z(  95)»REZ  ) 

.  (z( 

96) 

.NODUMP) * 

(Z( 

97) 

.UN97  )»(Z( 

98) 

»UN98 

). 

INP 

860 

2(Z(  99) »UN99  ) 

»  CZ(IOO) 

.EVAPM 

)  . 

(Z(101) 

»EVAPEN>»(Z(102) 

.evapmu) » 

INP 

870 

3(Z(103) .EVAPMV) 

» (Z(104) 

.EZPH2 

)  » 

(Z(105) 

rSNL  ) » (Z( 106) 

.STL 

). 

INP 

880 

4(Z(107)»TAXRT  ) 

r (Z(108) 

.IDNMAP) ' 

(Z(109) 

»!PRMAP)r(Z(110) 

.ROEPS 

). 

INP 

890 

5(Z(111) #RHINI  ) 

»(Z(112) 

»V  INI 

)  . 

(Z(113) 

rFlNAL  ) *  (Z(114) 

.IVMAP 

). 

INP 

900 

6(Z(115) #RHOZ  ) 

» (Z(116) 

»  ESA 

)r 

(Z( 117) 

rESEZ  ) » ( Z ( 1 1 6 ) 

»ESB 

). 

INP 

910 

7(Z(119) .ESCAPA) 

» <Z(120) 

.ESESP 

)  . 

(Z ( 121 ) 

.ESESQ  ) t (Z( 122) 

»eses 

>* 

INP 

920 

8(Z(123) .ESALPH) 

» (Z(124) 

.ESBETA) » 

(Z1125) 

.ESCAPB) r (Z(126) 

.IUMAP 

9 

INP 

930 

9(Z(127).SS1  ) 

» (Z(128) 

.  SS2 

)  r 

(Z( 129) 

rUMIN  ) . (Z (130) 

»SS4 

) 

INP 

940 

EQUIVALENCE 

INP 

950 

KZC131)  .PRTIME) 

» (Z(132) 

.EOR 

; . 

(Z1133) 

.EOT  ) » (Z(134) 

.EOB 

)  . 

INP 

960 

2(Z(135) »EMOR  ) 

» (Z(136) 

»DXF 

)  r 

(Z ( 137) 

.DYF  ) » (Z(138) 

.RHOMIN) » 

INP 

970 

3(Z(139) .STAB) » 

(Z( 140 )  . 

XIENRG) . 

(Z<141) 

.XKENRG).  (Z(l42) .XTENRG) 

» INP 

980 

4(Z(143).STT  ) 

» (Z(144) 

fDTMIN 

)  » 

(Z(145) 

.TRNSFC) . (Z(146) 

»EMOT 

). 

INP 

990 

5 ( Z ( 147 ) » JPRO J  ) 

» (Z(148) 

.cnaut 

). 

IZ(149) 

»BBAR  ) . ( Z ( 150  > 

.EMOB 

) 

INP1000 

INP1010 

INP1020 

INP1030 


. . INP1020 

INP1030 

END  OF  COMMON  INP1040 

INP1050 

. INP1060 

INP1070 

***  M2T  MUST  EQUAL  NUMBER  OF  WORDo  IN  Z-ARRAY.  INP1080 

MZT=150  INP1090 

***  SET  WFLAGF=1.  TO  SAY  THIS  IS  FIRST  CYCLE  OF  THIS  RUN.  INP1095 
WFLASFsl.  INP1100 

***  READ  AND  PRINT  ID  HEADING  CARD  (FIRST  CARD  IN  INP1110 

INPUT  DECK)  INP1115 

READ  (5.370)  IWS  INP1120 

WRITE  (6.370)  IWS  INP1130 
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***  CARDS  ROUTINE  WILL  READ  AND  PRINT  FIRST  DATA  CARD.  INP1X40 

CALL  CARDS  INP1150 

***  PK(3).LT.O.  means  THIS  PROBLEM  IS  being  RESTARTED  FROM  INPX152 
TAPE  7  AND  SETUP  IS  NOT  NEEDED.  INPU55 

IF  (PK(3) .LT.O.)  GO  TO  70  INP1160 

***  SINCE  THE  SETUP  ROUTINE  WRITES  ON  TAPE  7.  MAKE  INP1170 

SURE  THIS  IS  A  SETUP  AND  NOT  A  RESTART  RUN  TO  AVOID  INP1180 

WRITING  OVER  A  GOOD  DUMP  TAPE.  INP1190 

CALL  CARDS  INP1190 

***  Z(l)=PROB  IS  DEFINED  9Y  THE  SECOND  CARD  OF  A  SETUP  INP120O 

DECK.3UT  IS  NOT  DEFINED  IN  A  RESTART  DECK.  INP1205 

THEREFORE  IF  Z(1>=0,.  THIS  IS  A  RESTART  RUN.  AND  IF  INPI210 

Z(1).NE.0.#THIS  IS  A  SETUP  RUN.  INP1215 

IFtPROB.EQ.Q. )GO  TO  230  INP1220 

CALL  SETUP  INPI230 

GO  TO  70  INP1240 

CONTINUE  INP1250 

CALL  CARDS  INP1260 

***  INITIALIZE  P-STORAGE.  INP1265 

DO  30  K-l.KMAXA  INP1270 

P(K>=0»0  INP1280 

***  SET  T  AND  NC  SO  THEY  WILL  EQUAL  ZERO  ON  FIRST  EDIT  INPX282 

PRINT  AFTER  BEING  INCREMENTED  BY  CDT.  INP1284 

T=T-DTNA  INP1290 

NC=NC-1  INP1300 

***  CHECK  FATAL  INPUT  ERRORS.  INP1305 

IF (RHOZ.LE.O. )  GO  TO  260  1NP1310 

IF (ESCAPA.LT .Oo )  GO  TO  270  INP1320 

IF ( IMAX.EQ.O.OR. JMAX.EQ.O)  GO  TO  280  INP1340 

***  DEFINE  CONSTANTS  USED  THROUGHOUT  CALCULATION.  INP1345 

CNAUT=SQRT(ESCAPA/RHOZ)  \  INP1350 

WS=ESESP-ESES  INP1360 

IF  ( WSoLE.n. )  WS=1,  INP1370 

SS1=1./WS  INP13eO 

TESTRH  s  .2*RH0Z  INP1390 

CYCLE=NC  INP1400 

NRZ=NREZ-NUMREZ  INP1420 

SOLID=AMDM*RHOZ  INP1430 

GAMMA=ESA+1.  INP1440 

TW0PI=2.*PI0Y  INPI450 

PMlN=10.**6  INP1460 

TRNSFC=.4  INP1470 

VT=10.**(-5)  INP1475 

SS2=1.  INP1480 

***  SET  NUMBER  OF  SYMBOLS  TO  BE  USED  IN  PRINTED  CONTOUR  INPI482 

MAPS.  INP1484 

lDNMAP=2e.  INP1490 

IPRMAP=26.  INP1500 

IVMAP=26.  INP1510 

IUMAP=26.  INPX520 

IEMAP=26.  INP153Q 

***  PRINT  VALUES  OF  MOST  INPUT  PARAMETERS.  INPX555 

WRITE  (6.3X0)  NUMREZ»JSTR»N6»IMAXr UMAX. 11. 12. JPROJ.NMPMAX. INTER. NUINPX560 
XMSC A . IPCYCL . ICSTOP . NFRELP » NDUMP7 . NODUMP » I VARDX » I V ARDY  INPX570 

WRITE(6»32Q)  DXF»OYF.RHOMIN.TESTRH»RHOZ»RHlNI»RHINIT.AMDM»SOLID»  VINPX580 
lT»EVAP.ROEPS,SN.BBAR.CNAUT#FINAL»STAB.DMlNrCVIS»SS2fCYCPH3#CZERO.SINP1590 
2TK1 #  STK2 » STEZ » ESA . ESB » ESC APA » ESC APB . ESALPH » ESBET A >  ESEZ » ESES » ESESP » INPX60  0 
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3ESESQ  * REZFCT  * SS4  *  Y2 > TRNSFC  * DTMIN * PRDELT * PRFACT*  PRLIM*  TSTOP 
C  ***  PRINT  0X»0Y  ARRAYS  WHEN  THE  CELL  DIMENSIONS  ARE 

C  VARIABLE. 

IF  ( IVARDX.EQ.O)  GO  TO  40 
WRITE  (6*330 ) 

WRITE  (6*350)  ( I *DX ( I ) *  1=1 » I MAX) 

40  IF  (IVARDYoEQ.O)  GO  TO  50 

WRITE  (6*340) 

WRITE  (6*350)  (U*OY(J) »U=1*UMAX) 

50  CONTINUE 

C  ***  WHEN  T.GT.O. *  PROBLEM  IS  BEING  RESTARTED. 

IF  (T.GT.Oo)  GO  TO  60 

C  ***  DEFINE  TIME  OF  FIRST  EDIT  PRINT  AFTER  CYCLE  0. 

PRTIME=PKQELT 
60  TO  300 

C  ***  PRDELT  =  Oc  WHEN  PRINTING  ON  CYCLES  RATHER  TIME* 

60  IF  (PRDELT. EQoO.)  GO  TO  300 

C  ***  DEFINE  TIME  OF  FIRST  EDIT  PRINT  AFTER  RESTART  CYCLE. 

IWS=T/PRCELT+1. 

PRTIME=FLOAT ( IWS) *PRDELT 
GO  TO  300 

C  ***  READ  DUMP  TAPE  7. 

70  CONTINUE 

IWS=0 

60  REWIND  7 

90  READ  (7)  PR(1) »PR(2) »N3 

C  ***  NR  =  NUMBER  OF  RECORDS  WRITTEN  BY  EACH  TAPE  DUMP. 

C  WHEN  N3=l* TRACER  POINTS  ARE  BEING  USEID  AND  MAKE  UP 

C  ANOTHER  RECORD  IN  EACH  TAPE  DUMP. 

NR=N3+7 

C  ***  FIRST  WORD  OF  FIRST  RECORD  OF  EACH  DUMP  SHOULD  BE 

C  555.0.  TEST  THIS  THREE  TIMES  BEFORE  EXITING. 

IF  (PR(l)-555.0>  100*110*100 
10o  IWS=IWS+1 

IF  (MOD (IWS* 3) )  220*220*80 
110  IF  (PR(2) )  100*120*120 

c  *4*  when  setting  up  a  problem  pr(2>  =  pk<2)  =  o.  when 

C  RESTARTING  A  PROBLEM*  TAPE  7  IS  READ  UNTIL 

C  PR(2) .GE.PK (2) *  THE  RESTART  CYCLE  NUMBER. 

120  IF  (PK (2) -PR (2) )  150*150*130 

130  DO  140  L=2»NR 

140  READ  (7) 

GO  TO  90 

150  READ  (7)  (2(1) *I=1*MZT) 

C  ***  MAKE  SURE  PROBLEM  NUMBER  ON  TAPE  (PROB)  MATCHES 

C  PROBLEM  NUMBER  ON  INPUT  CARDS  (PK(1)>. 

IF  (ABS(PROB-PK(1))-.01>  160*160*210 
160  READ  (7)  (U(I) »V(I) »AMX(I) *AIX(I) *P(I) *I=1*KMAXA) 

READ  (7)  X(0)*(X(I)»TAU(I)*JPM(I)»I=1*IMAX) 

READ  (7)  (Y(I) »I=0*JMAX> 

C  ***  Y2=-l.  WHEN  TRACER  POINTS  ARE  USED. 

IF  (Y2oGT. (-1.) )  GO  TO  170 

READ  (7)  ((XP(I*U)»YP(I*J)» 1=1 » II ) * J=1 * JJ) 

170  READ  (7)  (DX(I) *I=1»IMAX) 

READ  (7)  (DY ( J) *Url* UMAX) 

READ  (7)  PR(1) *PR(2) »PR(3) 

C  4<**  THE  FIRST  WORD  OF  THE  LAST  RECORD  OF  EAurt  DUMP  SHOULD 


INP1610 

INP1620 

INP1625 

INP1630 

INP1640 

INP1650 

INP1660 

INP1670 

INP1680 

INP1690 

INP1695 

INP1700 

INP1705 

INP1710 

INP1720 

INP1725 

INP1730 

INP1735 

INP1740 

INP1750 

INP1760 

INP1770 

INP1800 

INP1810 

INP1820 

INP1830 

INP1832 

INP1834 

INP1836 

INP1840 

INP1842 

INP1844 

INP1850 

INP1860 

INP1870 

INP1880 

INP1882 

INP1884 

INP1886 

INP1890 

INP1900 

INP1910 

INP1920 

INP1930 

INP1932 

INP1934 

INP1940 

INP1950 

INP1960 

INP1970 

INP1980 

INP1990 

INP200C 

JNP2010 

INP2020 

INP2030 

INP2032 
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c 

c 


40 


50 

c 

c 


c 

60 

C 


C 

70 

80 

90 

C 

••C 

C 

;  C 

c 

100 

iio 

c 

c 

c 

120 

130 

'140 

150 

C 

C 

160 


C 


170 


C 


3ESESQ , REZFC  T,SS4,Y2, TRNSFC  » DTMZ  N ,  PRDELT , PRFACT  »PRLIM, TSTOP 
***  PRINT  DX»OY  ARRAYS  WHEN  THE  CELL  DIMENSIONS  ARE 
VARIABLE. 

IF  (IVARDX.EO.O)  GO  TO  40 
WRITE  (br 330} 

WRITE  (6,350)  ( I ,DX ( I ) , 1=1 » IMAX) 

IF  (IVARDY.EQ.Q)  GO  TO  50 
WRITE  (6,340) 

WRITE  (6,350)  (J»OY( J) » J=l» UMAX) 

CONTINUE 

***  WHEN  T.GT.O.,  PROBLEM  IS  BEING  RESTARTED. 

IF  (T.GT.O.)  GO  TO  60 

»**  DEFINE  TIME  OF  FIRST  EDIT  PRINT  AFTER  CYCLE  0. 
PRTIM£=PKDELT 
GO  TO  300 

***  PRDELT  =  0.  WHEN  PRINTING  ON  CYCLES  RATHER  TIME. 

IF  (PRDELT. EQ.O.)  GO  TO  300 

**♦  DEFINE  TIME  OF  FIRST  EDIT  PRINT  AFTER  RESTART  CYCLE. 
IWSr.T/PRDELT+1. 

PRTIME=FLOAT ( IWS) *prdelt 
CO  TO  300 

***  READ  DUMP  TAPE  7. 

CONTINUE 
IWS=0 
REWIND  7 

READ  (7)  PR(1),PR(2),N3 

***  NR  =  NUMBER  OF  RECORDS  WRITTEN  BY  EACH  TAPE  DUMP. 

WHEN  N3=l, TRACER  POINTS  ARE  BEING  USED  AND  MAKE  UP 
ANOTHER  RECORD  IN  EACH  TAPE  DUMP. 

NR=N3+7 

***  FIRST  WORD  OF  FIRST  RECORD  OF  EACH  DUMP  SHOULD  BE 
555.0.  TEST  THIS  THREE  TIMES  BEFORE  EXITING. 

IF  (PR(l>-555.0)  100,110,100 
IWS=IWS+1 

IF  (M0D(IWS,3>)  220,220,80 
IF  (PR(2) )  100,120,120 

***  WHEN  SETTING  UP  A  PROBLEM  PR(2)  =  PK(2)  =  0.  WHEN 
RESTARTING  A  PROBLEM,  TAPE  7  IS  READ  UNTIL 
PR(2).GE.PK(2),  THE  RESTART  CYCLE  NUMBER. 

IF  (PX(2)-PR(2) )  150,150,130 
DO  140  L=2,NR 
READ  (7) 

GO  TO  90 

READ  (7)  (Z(I),I=1,MZT) 

***  MAKE  SURE  PROBLEM  NUMBER  ON  TAPE  (PROB)  MATCHES 
PROBLEM  NUMBER  ON  INPUT  CARDS  (PK(i)>. 

IF  (ABS(PROB-PK(1))-.01>  160,160,210 

READ  (7)  (U(I),V(I),AMX(I),AIX(I),P(I),I=1,KMAXA) 

READ  (7)  <(0),(X(I),TAU(I),JPM(I), 1=1, IMAX) 

READ  (7)  <  Y  ( I )  ,I=(),JMAX) 

**»«  Y2=-l.  WHEN  TRACER  POINTS  ARE  USED. 

IF  (Y2.GT. (-1.))  GO  TO  170 

READ  (7)  ((XP(I»U),YP(I»J), 1=1, II ) , J=l, JJ) 

READ  (7)  (DX(I) ,7=1, IMAX) 

READ  (7)  (i'Y  (U)  ,U=1 , UMAX) 

READ  (7)  PR ( 1) ,PR( 2) ,PR( 3) 

***  THE  FIRST  WORO  OF  THE  LAST  RECORD  OF  EACH  DUMP  SHOULD 


INP1610 

INP1620 

1NP1625 

INP1630 

INP1640 

INP1650 

INP1660 

INP1670 

INP1680 

INP1690 

INP1695 

INP1700 

INP1705 

INP1710 

INP1720 

INP1725 

INP1730 

INP1735 

INP1740 

INP1750 

INP1760 

INP1770 

INP1800 

INP1810 

INP1820 

INP1830 

INP1832 

INP1834 

INP1836 

INP1840 

INP1842 

INP1844 

INP1850 

INP1860 

INP1870 

INP1880 

INP1882 

INP1884 

INP1886 

INP1890 

INP1900 

INP1910 

INP1920 

INP1930 

INP1932 

INP1934 

INP1940 

INP1950 

INP1960 

INP1970 

INP1980 

INP1990 

INP2000 

INP2010 

INP2020 

INP2030 

INP2032 
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C  BE  55b. 0  OR  666.0*  INP2034 
175  IF ( PR ( 1 ) -555.0 )  240,10,180  INP2040 
150  lF(PR(2>-666,0)  250,10,250  lNP2GoO 


200 

CALL  CARDS 

CALL  SETUP 

GO  TO  20 

C 

*** 

PROBLEM  NUMBER  ON  TAPE  7  NOT 

the  same  as  problem 

C 

NUMBER  ON  INPUT  CARDS. 

210 

NK=1SQ 

GO  TO  290 

C 

*** 

CANNOT  FIND  FIRST  WORD  OF 

first  record. 

220 

NK=100 

GO  TO  290 

C 

*** 

not  a  restart  and  YET  Z(l) 

0. 

250 

NK=5 

GO  TO  290 

C 

*** 

FIRST  WORD  OF  LAST  RECORD 

IS 

INCORRECT. 

240 

NK=175 

GO  TO  290 

C 

*** 

FIRST  WORD  OF  LAST  RECORD 

IS 

INCORRECT. 

250 

NK=180 

GO  TO  290 

C 

***  rhoz.le.o. 

260 

NK=32 

GO  TO  290 

C 

***  ESCAPA.LT. 0. 

270 

NK=34 

GO  TO  290 

C 

***  imax  or  jmax  is  zero 

280 

NK=36 

290 

NR=1 

C  ***  PRINT  FIRST  THREE  WORDS  OF  DUMP  <PR(1> »PR(2> »N3> 

C  AND  ZU51)  »Z(152)  ,Z<153>. 

WRlTE(6c 360)  PR(1),  Z(151>»  PR<2),  Z(152),  N3»  Z(153) 

CALL  ERROR 
300  RETURN 
C 


INP2070 

INP2080 

INP2090 

INP2092 

INP2094 

INP2100 

INP2110 

INP2115 

INP2120 

INP2130 

INP2135 

INP2140 

INP2150 

INP2155 

INP2160 

INP2170 

INP2175 

INP2180 

INP2190 

INP2200 

INP2210 

INP2220  ' 

INP2230 

INP2240 

INP2250 

INP2260 

INP2270 

INP2280 

INP2282 

INP2284 

INP2300 

INP2310 

INP2320 


310  FORMAT  <//12X,9H  NUMREZ=, I2,7H  USTR=,I3»5H  N6=I3,7H  IMAX=,  I3F7INP2330 
1H  JMAX=»I3*5H  I1=»I3,5H  I2=,I3,8H  JPR0J=,I3,9H  NMPMAX=, I5» 8H  INP2340 

2  INTER=»I2»9H  NUMSCA=,I2»/8H  IPCYCL=, I3,9H  ICSTOP=, I4,9H  NPRELPINP235C 
3=»I3»9H  NDUMP7=»I3»9H  N0DUMP=»I2»9H  IVARDX=* 12 ,9H  IVARDYz, I2//INP2360 
4)  INP2370 

320  FORMAT  (1X»120H  DXF  DYF  RHOMIN  TESTRH  INP2380 

1  RHOZ  RHINI  RHll  2 '  AMDM  SOLID  INP2390 

2  VT/1X, lP10E12o4//lX» 120H  .PS  SN  INP2400 

3  &BAR  CNAUT  FINAL  STAB  '  DMIN  CVIINP2410 

4S  SS2/lX»lPl0E12.4//lXrl20H  CYCPH3  CZERO  INP2420 

5  STK1  STK2  STEZ  ESA  ESB  ESCAPA  1^2430 

6  ESCAP8  ESALPH/1X»1P10E12.4//1X»96H  ESBETA  ESINP2440 

7EZ  ESES  ESESP  ESESQ  REZFCT  SS4  INP245C 

8  Y2/1X,1P8E12.4//1X,72H  TRNSFC  DTMlN  PRDELT  INP24::0 

9  PRFACT  PRLIM  TSTOp/lXr 1P6E12.4)  INP2470 

330  FORMAT  (//7(3H  I,6X,2HDR,7X) >  INP2480 

340  FORMAT  <//7(3H  J,6X»2HDZ»7X) )  INP2490 

350  FORMAT  (7(14, 2X, 1PE9.3,3X) )  INP2500 

360  FORMAT  (1H1,5X,72H***  CHECK  FIRST  RECORD  OF  THE  DUMP  AND  FIRST  DAT 

1A  CARO  OF  THE  INPUT  deck  //  4X»7H0N  TAPE,41X,8H0N  CARDS  /  4X, 
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24HWS  =»F6.1*4X»7H(555.0) *24X*  8HZC151)  =?F8«4»3X» 16H( PROBLEM  NUMBE 
3R)  /  8H  CYCLE  =  #F6. 1»4X*18H(CYCLE  BEING  READ)»13X*  8HZU52)  =F5.1r 
46X » 15H  { RESTART  CYCLE)  /  4X#4HN3  =, 14* 6Xr 19H<TRACER  POINT  FLAG)  * 

512X*  8HZ1153)  =»F5.i#6X»14H{ RESTART  FLAG)) 

FORMAT  (I1»71H  INP2520 

i  )  INP2530 

END  INP2540* 
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SUBROUTINE  CARDS 

DIMENSION  TABLE (i) »CARD(7) *LABLE(1> 

DIMENSION  INPERR(l) 

COMMON  TABLE 

EQUIVALENCE ( TABLE ( 1 )  » LABLE ( 1 ) ) 

INPERR=0 
WRITE  (6*80) 

10  READ  (5*90)  IEND*LOC»NUMWPC* (CARD(I) »I=i»NUMWPC) 

WRITE  (6* 100)  l£ND*LOC*NUMWPC* (CARD(I) »X=1*NUMWPC) 

IF  (NUMxPCoLT.l)  GO  TO  50 
IF  (LOC.LT.l)  GO  TO  70 
DO  50  I=1*NUMW?C 
U=LOC+I-l 

IF  (IEND*NE.2)  GO  TO  20 
LA8LE{J)=;FIX(CARD(I) ) 

GO  TO  30 

20  TaBLE(J)=CARD(I) 

30  continue 

4U  IF  (iEND.NEol)  GO  TO  10 

IF  vINPERR.EQ.O)  RETURN 
STOP 

50  IF  (LOC.NE.O)  GO  TO  70 

DO  60  1=1*7 

IF  ( CARD ( I ) • NE • 0 • )  GO  TO  70 
60  CONTINUE 

WRITE  (6,120) 

GO  TO  40 

70  WRITE  (6*110) 

INPERR=1 
GO  TO  40 

C  FORMATS 

C 

60  FORMAT  (/18H  INPUT  CARDS///) 

90  FORMAT  ( II* 15* II* QP7E9.4) 

100  FORMAT  UH  14, 17* 13, 1P7E14.6) 

110  FORMAT  (//42H  ****  ERROR  ON  PRECEDING  DATA  CARD  *****♦*/) 

120  FORMAT  (//18H  BLANK  CARD  ****♦*/) 

END 


CRD  10 
CRD  20 
CRD  30 
CRD  40 
CRD  50 
CRD  60 
CRD  70 
CRD  80 
CRD  90 
CRD  100 
CRD  110 
CRD  120 
CRD  130 
CRD  140 
CRD  150 
CRD  160 
CRD  170 
CRD  180 
CRD  190 
CRD  200 
CRD  210 
CRD  220 
CRD  230 
CRD  240 
CRD  250 
CRD  260 
CRD  270 
CRD  280 
CRD  290 
CRD  300 
CRD  310 
CRD  320 
CRD  330 
CRD  340 
CRD  350 
CRD  360 
CRD  370 
CRD  380- 


\ 

\ 
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SUBROUTINE  SETUP 


DIMENSION  AMX12502) #AIX(2502) .U(2502> 


X(52)  .XX<54)  »TAU{52) 

Y(102)  .YY(104)  .FLEFTUO 

6AMCC102) . 

PK ( 15) »  Z(ISO)  » 

XP(26»5i>.YPC26»51>» 

PL(2Q4)  »UL(204>  .PRC204) 

RSN(S2) »  RST (52) » 

CMXPC5)  .CMYP(5)  »IJ(5> 

0XC52)  » DOX ( 54 )  #DY(1Q2) 

SNB(52)  .STB (52)  »UK(52»3) 

***  DIMENSIONED  ARRAYS 


»U(2502)  »V(2502)  .P(2502)  . 

»TAU(52)  .JPM(52)  » 

»FLEpT(102) .  YAMC(102) »  SXGC(1Q2)» 


»JK(5)  » 

rDDY(104)  » 

»VK(52,3)  »RH0(52»3) 


SET  100 
SET  110 
SET  120 
SET  130 
SET  140 
SET  150 


***  Z-BLOCK  IS 

SAVED  ON  TAPE. 

SET 

160 

COMMON 

Z 

SET 

170 

COMMON 

PK 

SET 

180 

COMMON 

YY» 

XX 

SET 

190 

COMMON 

SDOX. 

ddy 

SET 

200 

COMMON 

AMX. 

AlX» 

U»  V»  P 

SET 

210 

COMMON 

TAU. 

■JPM 

SET 

220 

COMMON 

UL  t 

PL 

SET 

230 

COMMON 

XP  » 

Yp. 

CMXP.  CMYP 

SET 

240 

C 

***  non-dimensioned 

VARIABLES 

SET 

250 

COMMON 

1  AID 

»  AMMV 

»ammy 

» AMPY 

.AMUR  .AMUT 

.amvr 

9 

SET 

260 

1AMVT 

.DELEB  tOELER 

.DELET 

r  DELM 

.DTODX 

.DXYMIN.EAMMP 

.EAMPY 

9 

SET 

270 

2E 

» ERDUMP  » I 

.13 

.  I WS 

.  J 

.K  .KA 

.KB 

9 

SET 

280 

•  • 

3LL 

r MD  f HE 

>  MZT 

.NERR 

»NK 

.NPRINT. 

SET 

290 

4NR 

.NRZ  » NULLE 

.PIDTS 

.SIEMIN.SNR 

.SNT  »STR 

.SOLID 

9 

SET 

300 

5SUM 

.TCSTRH.TWOPI 

»URR 

»WS 

fWSA 

» wsb  .wsc 

.WFLAGF. 

SET 

310 

m 

• 

6WFLA6L  » WFLAGP 

\ 

SET 

320 

***  THE  FOLLOWING  EQUIVALENCES  MAKE  AVAILABLE 
X(0)»  Y(0) »  DX(O) .  DY(0) 

EQUIVALENCE  (XX(2)»  X(l))»  CYY'.2>»  Y(l)) 

EQUIVALENCE  (0DX(2)»  DX(1>).  CDDY(2)»  DY(1) ) 

***  SPECIAL  EQUIVALENCES  FOR  PH2  ONLY 


EQUIVALENCE 


(UL»FLEFT) » 
(PL.GAMC.PR) » 


(UL(103) rYAMC) » 
(PL(103)»SI6C) 


***  SPECIAL  EQUIVALENCES  FOR  PH3  ONLY. 


EQUIVALENCE 


(UL.RSN) » 
(PL»RST) * 

(P( 157) »  VK)  » 
(P(365).STB). 


( P . UK ) . 
(P(313) .SNB) * 
(P(417) »RHO) 


***  SPECIAL  EQUIVALENCES  FOR  EDIT 
EQUIVALENCE  (PR(1)»  IJ)»  (PR(6)»  JK) 


***  Z-ST0RA6E  equivalences 


EQUIVALENCE 


(Z(  1) .PROB  ) » ( 2.(  2)  .CYCLE  )  * 


SET  330 
SET  340 
SET  350 
SET  360 
SET  370 
SET  380 
SET  390 
SET  400 
SET  410 
SET  420 
SET  430 
SET  440 
SET  450 
SET  460 
SET  470 
SET  480 
SET  490 
SET  500 
SET  510 
SET  520 
SET  530 
SET  540 
SET  550 
SET  560 
SET  570 
SET  580 


5 6 


ooooo  r>  ooo 


H Z(  3)>DT  )*(Z< 

4) 

fNUMSP 

)  » 

5)  * 

NFRELP) ' 

(Z( 

6) » 

NDUMP7) 

. 

Eet 

590 

2(Z(  7) * ICSTOP) » (2 ( 

8) 

»PIDY 

)  » 

(2  ( 

9) 

t TOPMU  > 

,  IZi 

10) 

*  RTMU 

)  . 

SET 

600 

3(Z(  11) »STK1  )»(Z( 

12) 

fNUMREZ) t 

(Z( 

13) 

»eth  ) 

#  €ZC 

14) 

*UM4 

)* 

SET- 

610 

4(Z(  15) .RHINIT) * (Z( 

16) 

»PROJI 

)  f 

(Z( 

17) 

f UN17  ) 

r  (Z( 

18) 

» XMAX 

)t 

SET 

620 

5(Z(  19) »NZ  )»( Z( 

20) 

»NREZ 

)t 

(Z( 

21) 

t AMDM  ) 

,  (Z( 

22) 

» UVMAX 

)  r 

SET 

630 

6(Z(  23)»UN23  )»(Z( 

24) 

»DMlN 

)» 

(Z( 

25) 

»USTR  ) 

»(Z( 

26) 

»dtna 

), 

SET 

640 

7<Z'  27) »CVIS  )r(Z( 

28) 

» STK2 

)t 

(Zi 

29) 

rSTEZ  ) 

.  (Z( 

30) 

»nc 

)t 

SET 

650 

8(Z(  31)#JN31  )#(Z( 

32) 

*  NRC 

) » 

(Z( 

33) 

» I MAX  ) 

»(Z( 

34) 

t IMAXA 

)  r 

SET 

660 

9(Z(  35) » JMAX  ),(Z( 

36) 

r JMAXA 

)t 

(Z( 

37) 

rKMAX  ) 

'  (Z( 

38) 

. KM AX A 

) 

SET 

670 

EQUIVALENCE 

SET 

680 

l(Zl  39) t 80TM  )#<Z( 

40) 

rBOTMV 

)t 

(Z( 

41) 

»NUMSPT) 

»(Z( 

42) 

»CZERO 

)f 

SET 

690 

2(Z(  43) rNUMSCA) » tZ( 

44) 

»PRLIM 

)  t 

(Z( 

45) 

t PRDELT ) 

/( Z( 

46) 

.PRFACT) 

SET 

700 

EQUIVALENCE 

SET 

710 

1(Z(  47) » 11  )»(Z( 

48) 

» 12 

)  t 

(Z( 

49) 

» IPCYCL) 

» (Z( 

50  > 

t TSTOP 

)  / 

SET 

720 

2  (Z  (  51) rRHOFIL) * (Z( 

52) 

»TARGV 

), 

(Z< 

53) 

fN3  ) 

r  (Z ( 

54) 

t IVARDY) t 

SET 

730 

3(Z(  55) » VT  )r(Z( 

56) 

» N6 

)  t 

(Z( 

57) 

i»RTM  ) 

f  (Z( 

58) 

t  RTMV 

)t 

SET 

740 

4(Z(  59) * UN59  )»(Z( 

60) 

» N10 

)* 

(Z( 

61) 

»Nli  ) 

»(Z( 

62) 

r GAMMA 

)» 

SET 

750 

5(Z(  63) r  TOPM  )»(Z( 

64) 

»B0TMU 

)* 

(Z( 

65) 

»SN  ) 

»(Z( 

66) 

»TOPMV 

)  t 

SET 

760 

6(Z(  67)»PRYB0T)»(Z( 

68) 

»PRYT0P 

)  r 

(Z( 

€9) 

rPRXRT  ) 

#(Z( 

70) 

»CYCPH3) t 

SET 

770 

7(Z(  71) »REZFCT) » (Z( 

72) 

»TAR6I 

)» 

(Z( 

73) 

rPROJU  ) 

»(Z( 

74) 

rBBOUND) # 

SET 

780 

8(Z(  75) / EVAP  )#(Z( 

76) 

»ECK 

)t 

(Z( 

77) 

»NtCYCL' 

t  (Z( 

78) 

»II 

)  t 

SET 

790 

9(Z(  79) » JJ  )r( Zi 

80) 

»NMP 

), 

(Z( 

81) 

»Y2  > 

:  (Z( 

82  » 

»EZPH1 

) 

SET 

800 

Equivalence 

SET 

810 

1(Z(  83) fIVARDX) t (z( 

84) 

» T 

)f 

(Z( 

85) 

rNMPMAX) 

»(Z( 

86) 

»pmin 

)t 

SET 

820 

2(Z(  87) » INTER  )»t Z( 

88) 

»TAYB07 

)  t 

(Z( 

89) 

»TAYTOP) 

»(Z( 

90) 

t iemap 

)r 

SET 

830 

3(Z(  91) »MC  )r(Z( 

92) 

»MR 

)t 

(Z( 

93) 

»MZ  ) 

r  (Z( 

94) 

»MB 

) 

SET 

840 

EQUIVALENCE 

SET 

850 

1(Z(  95) »REZ  )»(Z( 

96) 

*  NODUMP )* 

(Z( 

97) 

t  UN97  ) 

r(Z( 

98) 

»UN98 

)  t 

SET 

860 

2(Z(  99) *UN99  )»(Z(100) 

f evapm 

)  * 

CZ(lOl) 

rEVAPEN) 

»(Z(102) 

»EVAPMU)» 

SET 

870 

3(2(103) .EVAPMV) » (Z(104) 

»EZPH2 

)' 

(Z(105) 

»SNL  ) 

» (Z(106) 

»stl 

)t 

SET 

880 

4(Z(107)»TAXRT  MzdOS) 

* IDNMAP) * 

(Z(109) 

rlPRMAP) 

#(Z(110) 

»ROEPS 

)f 

SET 

890 

5(Z(111) »RHINI  ) t (2(112) 

»  VI'NI 

)  t 

(Z(113> 

rFlNAL  ) 

r(Z(114) 

rIVMAP 

)r 

SET 

900 

6(Z(115) rRHOZ  )#<Z(116) 

fESA 

)  ' 

(Z(117) 

»ESEZ  ) 

» (Z(118) 

»ESB 

)f 

SET 

910 

7 (Z(119) .ESCAPA) » (Z(120) 

♦ESESP 

)» 

(Z(121) 

»ESESQ  ) 

» (Z( 122) 

rESES 

)t 

SET 

920 

8(Z(123) »ESALPH) * (Z(124) 

»ESBETA) » 

(Z(125) 

» ESC APB) 

#(Z(126> 

rlUMAP 

)t 

SET 

930 

9(Z(127)»SS1  )#(Z(128) 

t  SS2 

)» 

(Z(129) 

rUMlN  ) 

» (Z(130) 

»SS4 

) 

SET 

940 

EQUIVALENCE 

. 

SET 

950 

1(Z(131) rPRTIME) » (Z(132) 

rEOR 

)f 

(Z(133) 

»EOT  ) 

» (Z(134) 

»EOB 

)  t 

SET 

960 

2(Z(135) r EMOR  ) » (Z(136) 

»DXF 

)  r 

(Z(13?) 

»DYF  ) 

» (Z(138) 

rRHOMIN) * 

SET 

970 

3(Z(139) »STAB) »  (Z(14Q)> 

XIENRG) 

> 

(Z(141) 

rXKENRG) 

»  (Z(142)»XTENRG; 

»SET 

980 

4(Zd43)»STT  )»(Z(144) 

rDTMIN 

)  » 

(Z(145) 

rTRNSFC) 

t (Z(146) 

rEMOT 

)  , 

SET 

990 

5(Z(147) » JPROJ  ) t  (Z(148) 

»cnaut 

)» 

(Z(149) 

rBBAR  ) 

t  (Z(150) 

»EMOB 

> 

SET1000 

SET1010 

***  SPECIAL  EQUIVALENCES  FOR  SETUP  ONLY  SET1Q20 

SET1030 

EQUIVALENCE  ( RADIUS rPK( 12) ) t  (YCENTR»PK(l3) / »  (RHOSPH»Z(lOO) ) *  SET1040 

1  (SIESPH»Z(101) ) t  (VInSPH»Z(102) ) t (RHOOUT  *Z(1C3) )  SET1050 

SET1060 

COMMON/  SPHERE  /  ADDVL»  AREAFCr  ISPHMXr  JCF.NTR*  JSPHBT »  JSPHTPr  SET1070 

1  >-  RSQRDr  VOLSPHr  XL2  »  XR2  t  YBOTTMr  YC2  #  SET1080 

2  YDIFFB#  YDlFFlr  YDIF^Or  YDlrFT»  YLINTA*  YLINT8»  SET1090 

3  YLOWERr  YRlNTAr  YRINT6*  YTOP  »  YUPPER  SET1100 

SETlliO 

•  o  * . . . . . . . . . . . SET112Q 

SET113C 

END  OF  COMMON  SET1140 

SET1150 


5T 


SET1160 


c 

SET1170 

IF  (IVAROY.6T.O)  60  TO  30 

SET1180 

c 

CET1190 

c 

***  IF  OY  VARIABLE* Y(I)  WILL  BE  READ  IN  RATHER  THAN 

SET1200 

o 

CALCULATED* 

SET1210 

c' 

SET1220 

Y(1)=0YF  . 

SET1230 

00  10  J=2»JMAX 

SET1240 

Y  ( J)=Y  ( J-D+DYF 

SET1250 

10 

CONTINUE 

SET1260 

c 

SET1270 

c- 

***  IF  OY  VARIABLE*  DYU)  WILL  BE  CALCULATED  FROM  THE  YU) 

SET1280 

c 

READ  IN*  IF  DY  CONSTANT'  OYU)  WILL  EQUAL  OYF  FOR 

SET1250 

c 

ALL  I. 

SET1300 

c 

SET1310 

00  20  I=1»JMAX 

SET1320 

20 

DY(I)=OYF 

SET1330 

GO  TO  50 

SET1340 

c 

SET1350 

c 

***  CALCULATE  VARIABLE  DYU)» 

SET1360 

30 

UO  40  I=1»JMAX 

SE.T1370 

40 

DYU)=Y(I)-YU-l) 

SE 71380 

50 

CONTINUE 

SET1390 

C 

SET1400 

C 

***  IF  OX  VARIABLE'  X(I)  WILL  BE  READ  IN  RATHER  THAN 

SET1410 

C 

CALCULATED 

SET1420 

c 

SET1430 

IF  UVARDX.GT.O)  60  TO  80 

SET1440 

X(1)=0XF 

SET1450 

* 

00  60  1=2' IMAX  \ 

SET1460 

XU)=X<I-1)+DXF 

SET1470 

60 

CONTINUE 

SET1480 

C 

SET1490 

c 

***  IF  OX  VARIABLE'  OX U) WILL  BE  CALCULATED  FROM 

SET1500 

c 

THE  XU)  READ  IN.  IF  DX  CONSTANT'  DX(I)  WILL 

SET1520 

c 

EQUAL  DXF  FOR  ALL  I. 

SET1525 

c 

SET1530 

00  70  1=1  UMAX 

SET1540 

DX(I)=OXF 

SET1550 

70 

CONTINUE 

SET1560 

GO  TO  100 

SET1570 

c 

• 

SET1580 

e 

***  CALCULATE  VARIABLE  OXU) 

SET1590 

c 

i 

SET1600 

80 

DO  90  1=1* IMAX 

SET1610 

90 

0XU)=X(I)-XU-1) 

SET1620 

C 

***  make  sure  ox  ano  oy  arrays  have  been  defined* 

SET1625 

95 

IF  (DXU).GT.O..ANO.DYU)  *6T*0.)  60  70  100 

SET1630 

60  TO  770 

SET1640 

100 

CONTINUE 

SET1650 

c 

SET166Q 

c 

***  PK (3)  =  -3.  WHEN  RESTART I N6  FROM  A  CLAM  TAPE. 

SET1662 

c 

PROPERTIES  of  cells  have  already  been  defined 

SET1664 

c 

8UT  TRACER  POINTS  HAVE  NOT. 

SET1666 

IF  (PK(3).EQ.(-3.))  GO  TO  700 

SET1670 

c 

**«  PRYBOTs-1.  MEANS  THE  PROJECTILE  PACKAGE 

SET 1672 

56 


BWW5P/S 


L 

c 


c 

310 


120 

150 

C 

140 


150 

C 

160 

C 


.C 

170 


160 


190 

C 

200 

C 

210 

C 


IS  NOT  BEING  USED.  SET  1676 

IF  (PKY60T.L1 .0. >  60  i 0  200  SET1680 

***  DEFINE  CELL  BOUNDARIES  (MB»MCf MR)  OF  PROJECTILE  SET16S0 

PACKAGE.  SET1695 

IF  (1VARDY.GT.0)  GO  TO  110  SET1700 

***  CALCULATION  FOR  CONSTANT  DY.  SET1705 

McJ=INT  (PRYB0T/DYF+.5)  +1  SET1710 

IF  (MBoGT . JMAX)  GO  TO  200  SET1720 

M=1  SET1730 

MC=INT (PRYTOP/DYF+. 5)  SET1740 

IF  (MC .GT s JMAX)  MC=JMAX  SET1750 

GO  TO  160  SET1760 

***  CALCULATION  FOR  VARIABLE  DY.  SET1765 

DYSUM=0 .  SET1770 

1=0  SET1780 

*♦*  SEARCH  FOR  J-VALUE  OF  BOTTOM  OF  PROJECTILE  (MB)*  SET1785 

IF  (PRYBOT.EQ.O.)  GO  TO  130  SET1790 

DO  120  1=1 > JMAX  SET1800 

DYSUM=DYSUM+OY ( I )  SET1810 

IF  (PRY80T.LT.DYSUM+.5^DY(I+1) .AND.PRYB0T.GE.DYSUM-.5*DY(I))  GO  T0SET1320 
1  130  SET1830 

CONTINUE  SET1840 

GO  TO  200  SET1859 

M3=MIN0(I+1#  JMAV.)  SET1860 

M=1  SET1870 

***  SEARCH  FOR  J-VALUE  OF  TOP  OF  PROJECTILE  CMC).  SET1875 

DO  140  I=M6» JMAX  SET1880 

DYSUM=DYSUM+DY(I)  SET1890 

IF  (PRYT0P.GE.DYSUM-.5*DY(I)3AND.PRYT0P.LT.DYSUM+.5*DY(I^1))  GO'  TOSET1900 
1  150  SET1910 

CONTINUE  SET1920 

MC=JMAX  SET1930 

GO  TO  160  SET1940 

MC=I  SET1950 

***  CALCULATION  OF  I -VALUE  OF  RIGHT  SIDE  OF  PROJECTILE  (MR)SET1955 


IF  (IVARDXoGT.O)  GO  TO  170 

***  CALCULATION  FOR  CONSTANT  DX. 
MR=INT (PRXRT/DXF+.5) 

IF  (MR.GT.IMAX)  MR=IMAX 
GO  TO  210 

***  CALCULATION  FOR  VARIABLE  DX. 
DXSUM=0 . 

DO  180  1=1 » I MAX 
DXSUM=DXSUM+DX ( I ) 


SET1960 

SET1965 

SET1970 

SET1980 

SET1990 

SET1995 

SET2000 

SET2010 

SET2020 


IF  (PRXRT,GE.DXSUM".5*DX(D . AND.PRXRT.LT,DXSUM+.5*DX( I+l) )  GO  TO  1SET2030 
190  SET2040 

CONTINUE  SET2050 

MR=IMAX  SET2060 

GO  TO  210  SET2070 

MR=I  SET2080 

GO  TO  210  SET2090 

***  M=0  MEANS  THE  PROJECTILE  PACKAGE  IS  NOT  3EING  USED*  SET2100 

M=0  SET2110 

***  TAYBOT=-l.  MEANS  THE  TARGET  PACKAGE  IS  NOT  BEING  USED.  SET2115 

IF  (TAY80T.LT.O.)  GO  TO  310  SET2120 

***  DEFINE  CELL  BOUNDARIES ( MZ»  N  r  ME)  OF  TARGET  PACKAGE.  SET2130 

IF  (IVARDY.GT.O)  GO  TO  220  SET2140 
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***  calculation  for  constant  dy. 

MZ=INT(TAY80T/DYF+.5)+l 
IF  (MZ.6T.JMAX)  GO  TO  310 
MO=l 

N=lNT(TAYT0P/DYF+.5) 

IF  (N.GT (UMAX)  N=JMAX 
GO  TO  270 

***  CALCULATION  FOR  VARIABLE  DY. 

DYSUM=0<, 

1=0 

***  SEARCH  FOR  J-VALUE  OF  BOTTOM  OF  TARGET  (MZ). 

IF  (TAYBOT .EQ.O. )  GO  TO  240 
DO  230  1=1 r UMAX 
DYSUM=OYSUM+DY(IJ 

IF  ( TAYBOT . GE. DYSUM-. 5*DY < I ) . AND . TAYBOT . LT. DYSUM+ . 5*DY ( 1+1 ) ) 

1  240 
CONTINUE 
GO  TO  310 
MZ—M1N0 ( I +1 » JMAX ) 

MO=l 

**♦  SEARCH  FOR  J-VALUE  OF  TOP  OF  TARGET  (N) . 

DO  250  I=MZ»JMAX 
DYSUM=DYSUM+DYII) 

IF  (TAYTOP.GE.DYSUM-.o*DY(I) .AND.TAYTOP.LT. DYSUM+.5#DY(I+1) ) 

1  260 
CONTINUE 
N-JMAX 
GO  TO  270 
N=I 

***  CALCULATION  OF  I-VALUE  OF  RIGHT  SIDE  OF  TARGET (ME) 
IF  (IVARDX.GT.O)  GO  TO  280 

***  CALCULATION  FOR  CONSTANT  OX. 

ME=INT(TAXRT/0XF*.5) 

IF  (ME.GT.IMAX)  ME=IMAX 
GO  TO  320 

***  CALCULATION  FOR  VARIABLE  DX. 

DXSUM=0. 

DO  290  I=l» IMAX 
DXSUM=DXSUM+DX(I) 

IF  (TAXRT.GE.0XSUM-.5*0X(I).AND.TAXRT.LT.DXSUM4.5*DX(I«1))  GO 
100 

■  CONTINUE 
ME=IMAX 
GO  TO  320 
ME=I 

GO  TO  320 

***  MO  =  0  MEANS  THE  TARGET  PACKAGE  IS  NOT  BEING  USED. 

MD=0 

KMAX=IMAX*JMAX+1 

KMAXA=KMAX+1 

JMAXA=JMAX+1 

IMAXA=IMAX+1 

***  INITIALIZE  PROPERTY  ARRAYS. 

DO  330  K=1»KMAX 
U(K)=0.0 
V(K)=0.0 
P(K)=0.0 


SET2145' 
SET2150 
SET2160 
SET2170 
SET2180 
SET2190 
SET220Q 
SET2205 
SET2210 
SET2220 
SET2225 
SET 2230 
SET2240 
SET2250 
GO  TOSET2260 
SET2270 
SET2280 
SET2290 
SET2300 
SET2310 
SET2315 
SET2320 
SET2330 
GO  TOSET2340 
SET2350 
SET2360 
SET2370 
SET2380 
SET2390 
.  SET2395 

SET2400 
SET2405 
SET2410 
SET2420 
SET243Q 
SET2435 
SET2440 
SET2450 
SET2460 
TO  3SET2470 
SET2480 
SET2490 
SET2500 
SET2510 
SET2520 
SET2530 
SET2540 
SET2550 
SET2560 
SET2570 
SET2580 
SET2590 
SET2595 
SET2600 
SET2610 
SET2620 
SET2630 


60 


AMX  <  K) =0 » 0 
AIX(K)=0.0 
CONTINUE 
PIQY=3. 1415927 
WS=X(1)**2 


SET2640 

SET2650 

SET2660 

SET2670 

SET2680 


***  CALCULATE  CELL-FACE  AREA*  THE  AREA  GENERATED  BY  SEGMENTSET2682 


XQ),X(I+1)  ROTATED  ABOUT  THE  2-AXIS. 

TAUCl)=PIOY*WS 
DO  340  I=2»IMAX 
WSA=X(I)**2 
TaU( I)iPJDY*(WSA-WS) 

WS-WSA 

CONTINUE 

ETH=0.0 

***  RADIUS. GT.O.  MEANS  SPHERE  IS  TO  BE  USED. 

SEE  SPECIAL  EQUIVALENCES  FOR  SETUP  FOR  LOCATION 
OF  PARAMETERS  DEFINING  DIMENSIONS  AND  PROPERTIES  OF 
SPHERE. 

IF  (RADIUS. LE.O.)  GO  TO  540 

***  COMPUTE  ISPHMX»  THE  I-INDEX  OF  THE  RIGHT-MOST  COLUMN 
C,..TAIMING  A  PART  OF  THE  SPHERE. 

DO  350  I=1»IMAX 

IF  (X(I).GE. RADIUS-. Q00001*DX(X>>  GO  TO  360 

CONTINUE 

ISPHMX=I 

T0TSPH=0. 

***  COMPUTE  JCENTR=J-INDEX  OF  SPHERE-CENTER 
DO  370  J=0.JMAX 

IF  KY(J)+.5*DY(J+1)).GT.YCENTR)  60  TO  380 
CONTINUE 

***  YCENTR  SHOULD  FALL  ON  CELL  BOUNDARY  * 

PRINT  OUT  INPUT  VALUE  AND  ADJUSTED  VALUE. 

WRITE  (6»790)  YCEnTR»Y(J> 

YCENTR=Y(J) 

JCENTR=J 

COMPUTE  JRADA  AND  JRADB. 

***  JRADB  =  THE  NUMBER  OF  CELLS  CONTAINING  A  PART  OF  THE 
SPHERE  FROM  THE  CENTER  TO  BOTTOM  EDGE 
***  JRADA  =  THE  NUMBER  OF  CELLS  CONTAINING  A  PART  OF  THE 
SPHERE  FROM  THE  CENTER  TO  TOP  EDGE 

JRADB=0 
JRADA=G 
JB=JCENTR 
JA=JCENTR+1 
SUM1=0 . 

SUM2=0. 

IF  (JCENTR.EQ.O)  60  TO  400 
SUM1=SUM1+DY(JB) 

J8=JB-1 

JRACB=JRADB+1 

IF  (SUM1.LT. (RADIUS-. 000001*DY(JB)))  GO  TO  390 
SUM2=SUM2+DY(JA) 

JA=JA+1 

JRADA=JRADA+1 

IF  (SUM2.LT. (RADIUS-. 00000l*DY(JA)))  GO  TO  400 

***  COMPUTE (1)JSPHTP=J-INDEX  OF  UPPER-MOST  ROW 
***  WHICH  CONTAINS  PART  OF  THE  SPHERE 


SET2684 
SET2690 
SET2700 
SET2710 
SET2720 
SET2730 
SET274C 
SET2750 
SET2760 
SET2770 
SET2780 
Sc.T279G 
SET2850 
SET2860 
SE'i  2870 
SET2900 
SET2910 
SET2920 
SET2930 
SET2940 
SET2950 
SET2960 
SET2970 
SET2980 
SET2990 
SET3000 
SET3010 
SET3020 
SET3030 
SET3035 
SET3040 
SET3050 
SET3060 
SET3070 
SET3080 
SET3090 
SET3100 
SET3110 
SET3120 
SET313Q 
SET3140 
SET3150 
SET3160 
SET3170 
SET3180 
SET3190 
SET3200 
SET3210 
SET3220 
SET3230 
SET3240 


6l 


J 


c 

c 


c. 


c 

c 

c 

c 

c 


c 

t 


c 

c. 


c 

c 


<41Q 
*  420 
C 


•c 

c. 


c 

430 

C 


***  ( 2 )  JSPHBT = J“I  PiDEX  OF_ LOWEST  ROW 

***  WHICH  CONTAINS  kAki  Oi*  iHt  SPHbP.ft. 

JSPHBTSHAXO ( 1 » JCENTR- JRADB+1 > 

JSPHTP=MINO  < UMAX  > JCENTR+JRADA ) 

YC2=YCENTR**2 

RSQRD=RADIUS**2 

*♦*  FOR  EACH  CELL  IN  RECTANGLE  FROM  X=0. 

***  TO  Xs { ISPHMX-1 ) *DXF  AND  FROM 

***  Y=(JSPHBT-1)*DYF  TO  Y=(JSPHTP>*DYF 

***  FIND  VOLSPH-VOLUME  OF  SPHERE  IN  CELL  K 
***  AND  SET  MASS  AND  SPEC.  INT.  ENERGY. 

00  530  I=1»ISPHMX 
K= ( JSPHBT-1) ♦IMAX+I+l 

***  X(I-1)=VALUE  OF  X  AT  LEFT  OF  COLUMN 

***  x(  i) -value  of  x  at  right  of  columf.  -  ; 

XL2=<X(I-1))**2 

XR2=IXCI))**2 

***  YLINTASV  -uEFT-INTERCEPT-ABOVE'CENTER 
***  YLINTBrY-LEFt-lNTERCEPT-BELOW-CENTER 
WS=SQRT(RSQRD-XL2) 
ylinta=ycentr+ws 

YLINTB=YCENTR~WS 

***  DOES  CURVE  INTERSECT  X=X(I) 

IF  (RSQRD.LE.XR2)  GO  TO  410 
***  YES 

WS=SQRT(RSQRD-XR2) 

YRINTA=YCENTR+WS 

YRINTB=YCENTR-WS 

GO  TO  420 

YRINTA=YCENTR 

YRINTB=YCENTR 

CONTINUE 

DO  520  J= JSPHBT » JSPHTP 

***  SKIP  IF  SPECIAL  CELL 
IF  (AMX(K).NE.O.)  SO  TO  520 
YTOP=Y(J) 

YBOTTM=YiJ-l) 

YDIFFT={ YTOP-YCENTR) **2 
YD2FFB=(YBOTTM-YCENTR)**2 
YDIFF0=AMAX1 ( YDIFFT » YDIFFB > 

yoxffi=aminkydifft,ydiffb> 

***  IS  ALL  OF  CELL  WITHIN  SPHERE  BOUNDARY. 

IF  ((YDIFF0+XR2>.GT.RSQRD)  GO  TO  430 

***  YES.  DEFINE  VOLUME  OF  CELL* 

V0LSPH=TAUU)*DY.(J) 

GO  TO  470 

***  NO.  IS  ALL  OF  CELL  OUTSIDE  SPHERE  BOUNDARY. 

IF  (<YDIFFI+XL2).LT.RSQRD)  GO  TO  440 
***  YES. 

VOLSPH=Q. 

GO  TO  510 

***  NO.  PART  OF  CELL  IS  WITHIN  SPHERE.  COMPUTE  VOLUME 
OF  PART  OF  CELL  INSIDE  THE  SPHERE  ANp  STORE 
IN  VOLSPH. 

IF  (J.GT.JCENTR)  SO  TO  450 
YLOWERSAMAX1 C YBOTTM » YLINTB ) 


SET3250 

it.  r  .3260 

5ET3270 

SET3280 

SET3290 

SET3300 

?ST3310 

1T.T3320 

SET3330 

SET3340 

SET3350 

SET3360 

SET3370 

SET3380 

SET3390 

SET3400 

SET3410 

SET3420 

SET3430 

SET3440 

SEJ3450 

SET3460 

SET3470 

SET3480 

SET3490 

SET3500 

SET3510 

SET3520 

SET3530 

SET3540 

SET355C 

SET3560 

SET3570 

SET3610 

SET3620 

SET3630 

SET3640 

SET3650 

SET3660 

SET3670 

SET3680 

SET3690 

SET3695 

SET3700 

SET3705 

SET3710 

SET3720 

SET3725 

SET3730 

SET3735 

SET3740 

SET3750 

SET3752 

SET3754 

SET3756 

SET3760 

SET3770 
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450 

4t»0 

470 

C 


C 

C 


C 

49u 

G 

500 

510 

C 

520 

C 

530 

540 


YUPPER=AMIN1 ( Y TOP* YRINTB) ^ 
AuDvu- v  Y70P“YUPPEk) »7Au\ I ; 

GO  TO  460 

YL0WER=AMAX1(Y60TTM*YRIN7A) 
YUPPER=AMIN1(YT0°»YLIN7A) 
ADDVL= ( YLOWER-YBQTTM) *TAU ( I ) 


SET370G 

r r^tinA 

I W f 

SET3800 

SET3810 

SET3820 

SET3830 


VOLSPH=ADDVL+PIDr*((RSQFxD-YC2-XL2)*(YUPPER-YLOWER>~<YUPPER**3-YLOWSET3840 


1ER**3) /3o+YCENTR*{ YUP?ER**2-YL0WER**2) ) 

WS=VOLSPH*RHOSPH 

AMX(K)=WS 

***  CHECK  WHETHER  THE  CELL  IS  FULL 
WSA=TAU(I)*DY(J> 

WSB=WSA-VOLSPH 

IF  IABS(WSB/WSA> .LT.ROEPS)  GO  TO  490 

***  ADD  RHOOUT  MATERIAL  TO  CELL 
WSB=WSB*RKOOUT 
AMX(K)=WS+WS8 

***  CHECK  WHETHER  MASS  IS  TOO  SMALL  TO  KEEP 
IF<AMX(K)/WSA.LT.EVAP*RHINI>  GO  TO  510 

***  USE  A  WEIGHTED  AVERAGE  OF  THE  PROPERTIES  OF  THE  SPHERE 
AND  THE  PROJECTILE  FOR  CELLS  PARTIALLY  IN  THE  SPHERE. 

A I X  ( K )  =  C  WS*SI ESPH+ WS8+PR0 J I )  /  AMX K  )  & 

V { K )  =  ( WS*V INSPH+WSB*V INI ) /AMX  <  K ) 

GO  TO  500 

***  ESSENTIALLY  ALL  OF  CELL  IS  IN  SPHERE 
AIX(K)=SIESPH 
V(K)=VINSPH 

***  SUM  SPHERE  VOLUME 
TOTSPH- TOTSPH+VOLSPK 
GO  TO  525i 
AMX(K)=0. 


K=K+IMAX 


***  END  OF  J-LOOP 
***  END  OF  I-LOOP 


SET3850 

SET5860 

SET3870 

SET3880 

SET3890 

SET3900 

SET3910 

SET3920 

SET3930 

SET3940 

SET3945 

SET3950 

SET3960 

SET3965 

SET3970 

SET3980 

SET3990 

SET4030 

SET4040 

SET4050 

SET4060 

SET4070 

SET4080 

SET4090 

SET4100 

SET4110 

SET4120 


PROJECTILE  PACKAGE  IS  NOT  BEING  USED. 


5  ) 

560 

570 


CONTINUE  SET4130 

WRITE  C 6 # 800 )  RHQSPHf RHI NI » RHINIT r RHOFILf  SIESPHf  PRO JI t TARGl » VINSPHSET4140 
If VINI» TARGV f  PROJU , RADIUS  »  PRYTOP  r  TAYTOP  #  Y CENTR  $ PRYBOT  t T A YBOT  t PRXRT #  SET4150 

SET4160 
SET4162 
SET4164 
SET4166 
SET4163 
SET4169 
SET4170 
SET4220 
SET4230 
SET4240 
SET4250 
SET4260 
SET4270 
SET4280 
SET4290 
SET4300 
SET4310 
SET4320 
SET4330 
SET4340 


2TAXRT 

*•.*  RESET.  BORROWED  Z-STORAGE  TO  ZERO. 

evapm  =  0. 

EVAPEN  =  Oo 
EVAPMU  =  Oo 
EVAPMV  =  0. 

***  M=0  MEANS  THE 
IF  (M.EQ.O)  GO  TO  610 
DO  600  I=MfMR 
K=(MB-1)*IMAX+I+1 

*♦*  ASSIGN  PROPERTIES  TO  CELLS  IN  PROJECTILE. 
DO  590  J=MBfMC 
IF  (AMX(K) oNE.O.)  GO  TO  550 
AMX(K)=RHINI*DY(J)*TAU(I) 

IF  (V(K).NE.Q.)  GO  TO  560 
V(K)=VINI 

IF  (U(K).NE.O.)  GO  TO  570 
U(K)=PROJU 

IF  (AIX(K) oNE.O.)  GO  TO  580 
AIX(K)=PROJI 
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5o0 

590 

6U0 

C 

610 

C 


620 

630 

640 

650 

C 


c 

c 

c 


660 

670 

660 

C 

C 

C 

C 

C 

C 


690 


700 

C 

C 

C 


CONTINUE 
K=K*IMAX 
CONTINUE 

***  MD=0  MEANS  THE  TARGET  PACKAGE  IS  NOT  BEING  USEO. 

IF  (MO. £0.0)  GO  TO  650 

***  ASSIGN  PROPERTIES  TO  CELLS  IN  TARGET • 

00  o40  I-MO.ME 
K=(mZ-1)*IMAX*I+1 
00  630  J=MZ*N 
IF  (V(K).NEoO.)  GO  TO  620 
V(K)=TARGV 

IF  (AMX(K) «N£.0. )  GO  TO  630 
AMX(K)=RHINIT*DYCJ)*TAU(I) 

AIX(K)=TARGI 

K-K+IMAX 

CONTINUE 

CONTINUE 

CYCLE=0.0 

OT=0.0 

NREZ=NUMREZ 

NZ=1 

***  KHOFIL=0.  WHEN  THERE  IS  NO  FILLER  MATERIAL  BETWEEN 
PROJECTILE  AND  TARGET. 

IF  CKHOFIL.EG.O.)  GO  TO  680 

***  FILL  BETWEEN  PACKAGES  WITH  MATERIAL  OF  OENSITY=RHOFIL. 

MC=MC+1 

MZ=MZ-1 

00  670  I— 1 » IMAX 

K=(MC-1)*IMAX+I+1 

DO  660  J=MC.MZ 

AMX ( K ) =RHOF IL*DY ( J) *TAU( I ) 

K=K+IMAX 

CONTINUE 

N3=0 

***  PK(14).GT.O.  MEANS  COME  CELLS  WILL  BE  DEFINED 
AFTER  PACKAGES  ARE  SET  UP. 


SET4350 

SET4360 

SET4370 

SET4380 

SET4390 

SET4395 

SET4400 

SET4410 

SET4420 

SET4430 

SET4440 

SET4450 

SET4460 

SET4470 

SET4480 

SET4490 

SET4500 

SET4510 

SET4520 

SET4530 

SET4540 

SET4550 

SET4560 

SET4565 

SET4570 

SET45B0 

SET4590 

SET4600 

SET4610 

SET4620 

SET4630 

SET4640 

SET4650 

SET4660 

SET4670 

SET4672 

SET4674 


IF  (PK(l4).GT.O.)  CALL  CARDS  SET4680 

***  CALCULATE  INITIAL  VALUE  OF  TOTAL  ENERGY  TO  BE  ADJUSTED  SET4682 

when  material  is  evaporated  or  crosses  a  transmittive  SET4684 


BOUNDARY  AND  TO  BE  USED  IN  EDIT  TO  CHECK  ERROR  IN  SET4686 


ENERGY  SUM. 


SET4688 


DO  690  K=2»KMAX  SET4690 

£TH=ETH+AMX(K)*( .5*<U(K)**2+V(K)**2)+AIX(K> )  SET470G 


CONTINUE  SET4710 

XMAX=X(IMAX)  SET4720 

TXMAX=XMAX*2.0  SET4730 

YKAX=Y(JMAX)  SET4740 

TYMAX=YMAX*2.0  SET4750 

IF  ( Y2.GT. (-1 . ) )  GO  TO  750  SET4760 

***  PUT  TRACER  POINT  IN  CENTER  OF  EVERY  OTHER  NONEMPTY  CELLSET4770 

IN  EVERY  OTHER  ROW.  THE  TRACER  POINT  COORDINATES  OF  SET4772 

EMPTY  CELLS  ARE  (0*0).  SET4774 

II=IMAX/2  SET4780 

Jj=JMAX/2  SET4790 

DO  720  J=1*JJ  SET4800 

DO  720  1=1*11  SET4810 


6k 


K=2*(  U-1)*IMAX+I) 

6ET482U 

IF  (AMX(K) bEQ.Oo)  GO  TO  710 

SET4830 

XP(I»J)=FL0AT(2*I-U-.5 

SET4840 

YP l I , J ) =FLOAT ( 2* J-l ) - . 5 

SET4850 

710 

NMP=NMP+1 

SET4860 

C 

***  NMPMAX  IS  THE  MAXIMUM  NUMBER  OF  TRACER  POINTS  TO 

SET4862 

C 

BE  USED  AnD  IS  DEFINED  IN  THE  INPUT  DECK. 

SET4864 

IF  (NMP.GEb NMPMAX)  GO  TO  730 

SET4870 

720 

CONTINUE 

SET4880 

GO  TO  740 

SET4890 

730 

JJ=J 

SET4900 

C 

***  N3=l  MEANS  TRACER  POINTS  ARE  BEING  USED*  ADDING 

SET4902  . 

C 

ONE  MORE  RECORD  TO  EACH  TAPE  DUMP. 

SET4904 

740 

N3=l 

SET4910 

750 

REWIND  7 

SET4920 

WS=555„0 

SET4930 

C 

WRITE  OUTPUT  FOR  OIL  ON  TAPE. 

SET4940 

WRITE  (7)  WS»CYClE*N3 

SET4950 

WRITE  (7)  (Z 1 1 > *I=1>M2T) 

SET4960 

WRITE  (7)  <U(I) »V(I) »AMX(I)»AIX(I) »P(I) *I=1»KMAXA) 

SET4970 

WRITE  (7)  X(0)r (X(I) ,TAUCl)rJPM<I)»I=l#IMAX) 

SET4980 

WRITE  (7>  (Y(I) *I=0»JMAX) 

SET4990 

IF  (Y2.GT * (-1. ) )  GO  TO  760 

SET5000 

WRITE  (7)  ( (XP(I»J) »YP(I*J) *1=1*11) »J=1»JJ> 

SET5010 

760 

WRITE  (7)  (DX(I) *I=1»IMAX) 

SET5020 

WRITE  17)  (DY(J) *J=lrJMAX) 

SET5030 

WS=666.0 

SET5040 

WRITE  (7)  WS*WS»WS 

5ET5050 

GO  TO  780 

SET5060 

C 

***  DX  AND/OR  UY  ARRAY  NOT  PROPERLY  DEFINED. 

SET5062 

C 

CHECK  VALUE  OF  DXF  AND  DYF  IF  ZONES  ARE  CONSTANT. 

SET5064 

C 

IF  VARIABLE*  CHECK  LOCATION  NUMBERS  USED  FOR 

SET5065 

C 

READING  IN  X  AND/OR  Y  ARRAY  ESPECIALLY  IF  ANY 

SET5066 

C 

VARIABLE  DIMENSIONS  WERE  CHANGED c 

SET5068 

770 

NK=95 

SET5070 

NR=2 

SET5080 

CALL  ERROR 

SET5090 

780 

return 

SET5100 

C 

SET5110 

790 

FORMAT  (/5X* 15HINPUT  YCENTR  -  »1PE12. 6 »6X*18HAD JUSTED  YCENTR  s 

* 1PSET5120 

1E12.6) 

SET5130 

600 

FORMAT  {////17X»18HINITIAL  C0NDITl0NS//llX*6HSPKERE*i3X»9HPACKAGE  SET5140 

11.21H  PACKAGE  2  FILLER//8H  DENSITY t !PlEl2.4»6XrlP3E12.4/8H  S.SET515Q 
21 «Eo  f 1P1E12o4»6X» IP2E12.4/8H  V*lPlEl2.4»6XrlP2E12.4/8H  SET5160 

3  U» 13X? 1P1E12.4/8H  RADIUS»1P1E12.4*5X*3H70P»1P1E10.4»1P1E12.4/8H  SET517G 

4YCENT  ER » 1P1E12. 4 1 2X 1 6HB0TT0M r 1P1E1G . 4  » 1P1E12, 4/23X  r  5HRIGHT  » 1P1E10 . SET5180 
54p 1P1E12.4)  SET5190 

END  SET5200- 


***> 

<£~ 


SUBROUTINE  COT 


C 

C 


C 

C 


C 

C 

C 

C 


C 

C 

C 


C 

c- 

c 


c 

c 

c 

c 

c 

c 


DIMENSION  AMXC2502) >AIX(2502) »U(2502) 

1  X (52)  »XX(54)  »TAU{52) 

2  Y (102)  » YY (104) 

3  6AMC (102) > 

4  PK(15) t  Z(150)  t 

5  XP(26»5l) >YP(26»51) # 

6  PL(204)  »UL(204)  >PR(204) 


>\J  (2502)  >P(25Q2)  > 

> JPM(52)  > 

»FLEFT (102) >  YAMC (102) t  SIGC(1Q2)» 


EQUIVALENCE  (XX(2)»  X(l))>  (YY(2)r  Y(l>) 

EQUIVALENCE  (DQX<2)>  DX(1))>  (DDY(2i>  DY (1) ) 

***  SPECIAL  EQUIVALENCES  FQR  PH2  ONLY. 

EQUIVALENCE 


(UL»FLEFT)» 
(PL»GAMCrPR) > 


(UL(103) » YAMC) > 
(PL(103)»SIGC) 


***  SPECIAL  EQUIVALENCES  FOR  PH3  ONLY 


EQUIVALENCE 


1 

2 

3 


(UL»RSN) t 
(PL»RST) t 
(P(157) »VK) » 
(P(365) »STB) > 


(P»UK) » 

(P(313)rSNB)» 

(P(417)rRH0) 


***  SPECIAL'  EQUIVALENCES  FOR  EDIT 
EQUIVALENCE  (PR(i)»  IJ) t  (PR<6) t  JK) 

♦**  Z-STORAS;-.  EQUIVALENCES 

EQUIVALENCE  (Z(  1) >PROB  )>(Z<  2)>CYCLE 


CDT 
•  CDT 
CDT 
CDT 
CDT 
CDT 
CDT 
CDT 
CDT 


10 

20 

30 

40 

50 

60 

70 

80 

90 


CDT  100 


7 

RSN(52) t  RST ( 52)  » 

CDT 

110 

a 

CMXP (5)  »CMYP(5)  >IJ(5)  » 

JK (5)  » 

CDT 

120 

V 

DX(52)  #DDX(54)  »DY(102)  * 

DDY (104)  > 

CDT 

130 

s 

SNB(52)  > STB (52)  >UK(52>3)  t 

VK(52>3)  >RH0(52>3) 

CDT 

140 

***  DIMENSIONED  ARRAYS 

CDT 

150 

***  Z-BLOCK  IS  SAVED  ON  TAPE. 

CDT 

160 

COMMON 

Z 

CDT 

170 

COMMON 

PK 

CDT 

180 

COMMON 

YY> 

XX 

CDT 

190 

COMMON 

DDXr 

DDY 

CDT 

200 

COMMON 

AMX> 

AIX>  U>  V#  P 

CDT 

210 

COMMON 

TAU> 

JPM 

CDT 

220 

COMMON 

UL  t 

PL 

CDT 

230 

COMMON 

XP  t 

YP»  CMXP»  CMYP 

CDT 

240 

***  NON 

[“DIMENSIONED  VARIABLES 

CDT 

250 

COMMON 

AID  > AMMV  > AMMY  rAMPY 

> AMUR  »AMUT 

»  amvr 

t 

CDT 

260 

1AMVT 

r DELES  > 

DELER  »DELET  >DELM  rDTODX  >DXYMIN>EAMMP 

>EAMPY 

> 

CDT 

270 

2£ 

>ERDUMP> I  >13  »IWS  rJ 

»K  >KA 

»KB 

f 

CDT 

280 

3LL 

>MD  > 

ME  t MZT  »NERR  >NK 

>nprint» 

CDT 

290 

4NR 

>NRZ  > 

NULLE  .PIDTS  >siemin#snr 

fSNT  »STR 

» SOLID 

> 

CDT 

300 

5SUM 

»TESTRH» 

TWOPI  »URR  t WS  >WSA 

>WSB  >WSC 

>WFLAGF» 

CDT 

310 

6WFLAGL 

t WFLAGP 

CDT 

320 

CDT 

330 

***  THE 

:  FOLLOWING  EQUIVALENCES  MAKE  AVAILABLE 

CDT 

340 

X(0)»  Y(0) »  DX(0) »  DY(0> 

CDT 

350 

CDT  360 
CDT  370 
CDT  380 
CDT  390 
CDT  400 
CDT  410 
CDT  420 
CDT  430 
CDT  440 
CDT  450 
CDT  460 
CDT  470 
CDT  480 
CDT  490 
CDT  500 
CQJ  510 
CDT  520 
CDT  530 
CDT  540 
CDT  550 
CDT  560 
CDT  570 
) r  CDT  580 


66 


oooooo  oooooooo 


1 ( Z (  3).QT  ) 

.  (Z( 

4) 

.  NUMSP 

)  . 

(z  ( 

5)  . 

NFRELP) » 

(Z( 

6) » 

NDUMP7) 

. 

CDT 

590 

2(Z(  7 ) . ICSTOP) 

.(Z< 

8) 

.PIDY 

)  . 

(Z( 

9) 

►  TOPMU  ) 

.  (Z( 

10) 

>RTMU 

)  » 

CDT 

600 

3(Z(  1D.STK1  ) 

.  (Z( 

12) 

.NUMREZ) » 

(Z( 

13) 

.eth  ) 

.  (Z( 

14) 

.  UN14 

)  . 

CDT 

610 

4(Z(  lb) .RHINIT) 

,(Z( 

16) 

.PP.OJI 

)  . 

(Z( 

17) 

►UN17  ) 

.  (Z( 

18) 

» XMAX 

)  . 

CDT 

620 

5(Z(  19) »NZ  ) 

»  Uy 

20) 

.NREZ 

) . 

(Z( 

21) 

» AMDM  > 

.  (Z( 

22) 

» UVMAX 

)  . 

CDT 

630 

o(Z(  23) . UN23  ) 

.(Z( 

24) 

»DMIN 

)  t 

(Z( 

25) 

.  JSTR  ) 

f  (Z( 

26) 

.dtna 

)  . 

CDT 

640 

7(Z(  27) »CVIS  ) 

.(Z( 

28) 

.  STK2 

) . 

(Z( 

29) 

.STEZ  ) 

.  (Z( 

30) 

»nc 

). 

CDT 

650 

8(Z(  31 ) » UN31  ) 

»(Z( 

32) 

.  NRC 

)  . 

(21 

33) 

.IMAX  ) 

.  (Z( 

34) 

» IMAXA 

)  . 

CDT 

660 

9 (Z (  3b) . JMAX  ) 

.  (2( 

36) 

.UMAXA 

) . 

(Z( 

37) 

.KMAX  ) 

.  (Z( 

38) 

.kmaxa 

\ 

t 

CDT 

670 

EQUIVALENCE 

CDT 

680 

1(Z(  39)  . BOTM  ) 

.(Z( 

40) 

.BOTMV 

)  9 

(Z( 

41) 

►NUMSPT) 

.  (Z( 

42) 

.CZERO 

). 

CDT 

690 

2(Z(  43) . NUMSCA) 

.  (Z( 

44) 

.PRLIM 

) . 

( Z( 

45) 

.PRDELT) 

.  (Z( 

46) 

.PRFACT) 

CDT 

700 

EQUIVALENCE 

CDT 

710 

1(ZC  47) » 11  ) 

.  (Z( 

48) 

.12 

) . 

(Z( 

49) 

» IPCYCL) 

»  (Z( 

50) 

.TSTOP 

)  . 

CDT 

720 

2(Z(  51) .RKOFIL) 

.  (Z( 

52) 

.TARGV 

)  . 

(Z( 

53) 

.  N3  ) 

.(Z( 

545 

.IVARDY)  . 

CDT 

730 

3(Z(  55). VT  ) 

.  (Z( 

56) 

.N6 

)  . 

(Z( 

57) 

»RTM  ) 

♦  CZ( 

58) 

.RTMV 

)  . 

CDT 

740 

4(ZC  59) »UN59  ) 

.(Z( 

60) 

.  N10 

)  . 

(Z( 

61) 

.Nil  ) 

» (Z( 

62) 

.gamma 

). 

CDT 

750 

5(Z(  63) » TOPM  ) 

.(Z( 

64) 

.BOTMU 

)  . 

(Z( 

65) 

.  SN  ) 

»(Z( 

66) 

.topmv 

). 

CDT 

760 

6(Z(  67).PRYdOT) 

.(Z( 

68) 

.PRYTOP) » 

(Z( 

69) 

.PRXRT  ) 

»(Z( 

70) 

.CYCPH3). 

CDT 

770 

7 (Z (  71) . REZFCT) 

.(Z( 

72) 

.TARGI 

)  . 

(Z( 

73) 

» PRO JU  ) 

»(Z( 

74) 

.BBOUND) » 

CDT 

780 

8(Z(  75) »EVAP  ) 

r(Z( 

76) 

.ECK 

)  < 

(Z( 

77) 

.NECYCD 

.  * "  ■ 

78) 

»II 

). 

CDT 

790 

9(Z(  79) » JJ  ) 

.(Z( 

80) 

»NMP 

) . 

(Z( 

81) 

»Y2  ) 

82) 

.EZPH1 

) 

CDT 

800 

EQUIVALENCE 

CDT 

810 

1(Z(  83) . I VARDX) 

r(Z( 

84) 

» T 

) . 

(Z  ( 

85) 

.NMPMAX) 

.( Z( 

86) 

.PMIN 

). 

CDT 

820 

2 ( Z (  87) » INTER  ) 

.(z( 

88) 

.TAYBOT) . 

(Z( 

89) 

.TAYTOP) 

.(Z( 

90) 

.iemap 

). 

CDT 

830 

3(Z(  91 ) » MC  ) 

r(Z( 

92) 

.MR 

) . 

(Z( 

93) 

.MZ  ) 

»(Z( 

94) 

.MB 

) 

CDT 

840 

equivalence 

CDT 

850 

1(Z(  95) r REZ  ) 

.(Z( 

96) 

.NODUMP) » 

(Z( 

97) 

. UN97  ) 

.(Z( 

98) 

»UN98 

)  . 

CDT 

860 

2(Z(  99) »UN99  ) 

» (z(ioo) 

.EVAPM 

) . 

(Z(101) 

.evapen) 

»(Z(102> 

.EVAPMU) t 

CDT 

870 

3(Z(103)»£VAPMV) 

. (Z(104) 

.EZPH2 

)  9 

(Z(105) 

jSNL  ) 

» (Z ( 106) 

.STL 

). 

CDT 

880 

4(Z(107)»TAXRT  ) 

. (Z(1Q8) 

» IDNMAP) . 

(Z (109) 

.IPRMAP) 

»(Z(110) 

.ROEPS 

). 

CDT 

890 

4(Z(111)»RHINI  ) 

#(Z(U2> 

» VINI 

)t 

(Z(113) 

rFlNAL  ) 

r (Z(114) 

flVMAP 

)t 

CDT 

900 

6(Z(115) .RHOZ  ) 

. (Z(116) 

»ESA 

). 

(Z(117) 

.ESEZ  ) 

. (Z(118) 

.ESB 

). 

CDT 

910 

7(Z(119) ? ESCAPA) 

» (Z(120) 

.ESESP 

). 

(Z(12I) 

.esesq  ) 

» (Z(122) 

.ESES 

)» 

CDT 

920 

8(Z(123) .ESALPH) 

» (z( 

124) 

.ESBETA) . 

(Z1125) 

. ESCAPB) 

»(Z( 

126) 

.IUMAP 

). 

CDT 

930 

9(Z 1127) »SS1  ) 

.  (z( 

128) 

»SS2 

) . 

(Z(129) 

.UMIN  ) 

» (Z(130) 

»SS4 

) 

CDT 

940 

EQUIVALENCE 

CDT 

950 

1(Z(131).PRTIME) 

.  (z(132.) 

»EOR 

) . 

(Z(133) 

.EOT  ) 

» (Z(134) 

.EC  3 

). 

cc; 

960 

2(Z(135) .EMOR  ) 

. (Z(136) 

.DXF 

). 

(Z(137) 

.DYF  ) 

. (Z(138) 

.RHOMIN) . 

CDT 

970 

3(Z(139) .STAB) . 

(Z(140). 

XIENRG) 

. 

( Z ( 141 ) 

.XKENRG) 

.  (Z(142) .XTENRG) 

.CDT 

980 

4(Z(143).STT  ) 

. (Z(144) 

.DTMIN 

) . 

(Z(145) 

.TRNSFC) 

. (Z( 146) 

»EMOT 

). 

CDT 

990 

5 ( Z ( 147 ) » JPRO J  ) 

» (Z<148) 

*cnaut 

). 

(Z(149) 

.BBAR  ) 

. (Z(150) 

.EMOB 

) 

CDT1000 

CDT1010 

CDT1P20 

CDT1030 


.  •  • . .  ......  . . . . . .  . CDT1P20 

CDT1030 

END  OF  COMMON  CDT1C40 

CDT1050 

. . .  .  .  .  o  . . . . . . . . . . CDT1060 

CDT1070 

♦♦♦  SPECIAL  EQUIV  FOR  ES  AND  CDT  CDT1080 

EQUIVALENCE  (RHOW.NUlLE)  CDT1090 

CDT1100 

♦♦♦check  courant  condition  and  particle  velocity.  cdtiiio 

♦♦♦RECORD  I  AND  J  OF  ZONE  WHERE  DT  IS  CONTROLLED.  CDT1120 

♦♦♦FIRST  CALCULATE  PRESSURES  FROM  EQ.  OF  ST,  CDT1130 

CDT1140 

CDT1220 
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10 


c 


c 

c 


c 

c 

c 


c 

c 

20 

c 

c 

c 

c 

c 

c 


c 

c 

30 


c 

c 

c 

c 

40 


C 

C 


50 


C 

C 


C 


tri al— q « 

SRATIQ=10.**1G 

♦♦WSC  WILL  BE  MAXIMUM  U  OR  V 

WSC=0. 

DO  60 
X=I+1 

DO  60  J=1»I2 

RBOW=AMX(K)/(TAUU)*DY(J> ) 

CAuL  ES 

♦♦♦  IF  DENSITY  OF  CELL  K  IS  LESS  THAN  RHOMIN*  IT'S 

VELOCITY  OR  SOUND  SPEED  IS  NOT  USED  IN  DETERMINING  DT. 
IF  (RHOW.LTcRHOMlN)  GO  TO  SO 
IF  (ABS(P(X  ).LT.PMIN)  P(!jsO. 

IF  (CNAUToGT.O.)  GO  TO  20 

♦♦♦CALCULATE  SOUND  SPEED  FOR  POLYTOPIC  GAS  WITH 
♦♦♦GAMMA  EQUAL  TO  ESA+U 
WS=SQRT  C  GAMMA+ABS <  P ( K ) ) /RHO W  > 

GO  TO  40 


♦♦♦CHECK  FOR  NEGATIVE  PRESSURE. 

IF  (P(K).GT.O.)  GO  TO  30 

♦♦♦  NEGATIVE  PRESSURES'.  NOT  ALLOWED  ALONG  GRID  BOUNDARY 
AND  NOT  ALLOWED  ANYWHERE  UNTIL  ACTIVE  GRID  REACHES 
JSTRl INPUT  PARAMETER  FOR  TURNING  ON  STRENGTH 
CALCULATIONS). 

IF  ( (IMAX.NE.I.ANO.I.EQ.IMAX) .OR. J.EQ. JMAX.0R.I2.LT. JSTR)  P(K)-0. 
♦♦♦PRESSURE  IS  NEGATIVE  OR  ZERO 

WS=CNAUT 
GO  TO  40 


♦♦♦PRESSURE  IS  POSITIVE. 


WS=CNAUT-f-BBAR*SQRT(P(K) ) 

WSA=SQRT ( GAMMA^P ( K  > /RHOW ) 

WS=AMAX1(WS»WSA) 

♦♦♦  WS  IS  SOUND  SPEED  OF  CELL  K. 

♦♦♦  WSB  IS  MAXIMUM  OF  RADIAL  AND  AXIAL  VELOCITY  OF  CELL  K. 
♦♦♦  WSC  STORES  MAXIMUM  VELOCITY  OF  CELLS  USED  TO  DETERMINE 
OT.  PRINTED  AS  MAXUV. 

WSB=AMAX1(ABS(U(K) ) t ABS(V(JO  ) ) 

WSC=AMAXi<WSC»WSB) 


WS— AMAXX  ( WS  *  W'SB ) 

♦♦♦  TRIAL  STORES  MAXIMUM  OF  VEl.OCTY  AND  SOUND  SPEED  USED 
TO  DETERMINE  DT.  PRINTED  AS  MAXCUV. 

IF  (WSoLE. TRIAL)  GO  TO  50 

tri al— ws 

IF  (WSoLE. 0.)  GO  TO  60 
DXYMIN=AMIN1(0X(I)  »DY(-J)) 

RATI0=DXYMIN/WS 
IF  ( RATIO oGT.SRATlO)  GO  TO 
♦*♦  I  AND  U  OF  CELL 
FOR  PRINTOUT. 

N10=I 


60 

CONTROLLING  DT  STORED  IN  N10  AND  Nil 


N11=J 

♦♦♦  SRATIO  IS  SMALLEST  VALUE  CALCULATED  FOR  RATIO. 
SRATIO=RATIO 


CDT1230 
CDT1240 
CDT1250 
CDT1260 
CDT1270 
COT1280 
CDT1290 
CDT1330 
CDT1340 
CDT1342 
CDT1344 
CDT1350 
CDT1360 
CDT1370 
CDT1380 
CDT1390 
CDT1400 
CDT1410 
CDT1420 
CDT1430 
CD! 1440 
CDT1450 
CDT1452 
CDT1454 
CDT1456 
CDT1458 
CDT1460 
CDT1470 
CDT1480 
CDT1490 
CDT1500 
CDT151Q 
CDT1520 
CDT1530 
CDT1540 
CDT1550 
CDT1552 
CDT1554 
CDT1556 
CDT1558 
CDT1560 
CDT1570 
CDT1580 
CDT1582 
CDT1584 
CDT1590 
CDT1600 
CDT1610 
CDT1620 
CDT1630 
CDT1640 
CDT1642 
CDT1644 
CDT1650 
CDT1660 
CDT1665 
CDT1670 


68 


c 

c 

60 

C 

C 

C 

6b 

C 

C 

C 


7U 

C 

C 

75 

80 

C 

C 


C 


C 

C 

90 

95 


***END  OF  I)  J  LOOP 


K=K+IMAX 

*** 


THERE  IS  PROBABLY  AN  ERROR  IN  THE  INP  )T 
THE  INITIAL  VELOCITY#  ENERGY  OR  DENSITY 


DT.  DTMIN  IS  AN 


IF  TRIAL. LE.O. 

PARAMETERS  FOR 
OF  THE  PACKAGES. 

IF  (TRIAL. LE.O.)  GO  TO  170 

***  IF  FINAL. EQ.O. USE  STAB  FOR  VALUE  OF  STABILITY  FRACTION 
IF  FINAL. GT.O, USE  A  GEOMETRIC  PROGRESSION  WITH  STAB 
AS  THE  INITIAL  VALUE  AND  FINAL  AS  THE  FINAL  VALUE. 

IF  (FlNALcEu. 0 • )  GO  TO  70 

STAb=2.*STAB 

STAB=AMIN1(STAS#FINAL) 

OT=STAB*SRATIO 

IF  (STAB. LT. FINAL)  GO  TO  80 

***  AFTER  STAB. GE. FINAL  CHECK  ON  SIZE  OF 
INPUT  PARAMETER  AND  CAN  BE  SET  TO  0. 

IF  (DT.LE. DTMIN)  GO  TO  150 
CONTINUE 

***  IS  CONTROL-CELL  ISOLATED 
K=(N11-1)*IMAX+N10+1 
WS=0 . 

IF  (N10.GT.1)  WS=AMX(K-1) 

IF  (NIOoLT. I MAX)  WS=AMX(K+1)+WS 
IF  (Nll.GT.l)  WS=AMX(K-IMAX)+WS 
IF  (Nll.LT . JMAX)  WS=AMX(K+IMAX)+WS 
IF  (WS.GT.O.)  GO  TO  90 

***  ISOLATED#  SO  DESTROY  IT. 

WS=(AlX(K)  +  (U(K)**?.-*-V(K)**2)*.5)*AMX(K) 

EVAPM=EVAPM+AMX(K) 

EVAPEN=EVAPEN+WS 
£TH=ETH-WS 

EV  APMU=EV APMU+AMX ( K ) *U ( K ) 

EVAPMV=EVAPMV+AMX(K)*V(K) 

WRITE  (6# 290)  N10»N11»T»DT»TRIAL# WSC#UMlN#PMIN 
AMX(K)=0. 

AIX(K)=0'. 

P(K)-0. 

U (K) “0 • 

V(K)=G, 

***  RECALCULATE  DT. 

GO  TO  10 

***  INCREMENT  TIME  AND  CYCLE. 

T=T+DTNA 

IF  (T.LT.O.)  GO  TO  160 
NC=NC+1 
CYCLE=NC 


CDT1630 

CDT1690 

CDT1700 

CDT1702 

CDT17Q4 

CDT1706 

CDT1710 

CDT1720 

CDT1730 

CDT1740 

CDT175C 

CDT1760 

CDT1770 

CDT178C 

CDT1790 

CDT1792 

CDT1794 

CDT1800 

CDT1810 

CDT1820 

CDT1830 

CDT1840 

CDT1850 

CDT1860 

CDT1870 

CDT1$8Q 

CDT1890 

CDT1900 

CDT1910 

CDT1920 

CDT1930 

CDT1940 

CDT1950 

CDT1960 

CDT1970 

CDT1980 

CDT1990 

CDT2000 

CDT2010 

CDT2020 

CDT2030 

CDT2035 

CDT2040 

CDT2050 

CDT2060 

CDT2070 

CDT2080 

CDT2090 


C 

c 


***  RESET  NPRINT.  NPRINT=1  ON  PRINT  CYCLES.  CDT2100 

NPRINT=0  CDT2110 

***  DEFINE  VELOCITY  AND  ENERGY  CUTOFFS  USED  IN  MAP  AND  PH2.CDT2115 
UMIn=TRIAL*ROEPS  CDT2120 

SIEMIN=UMIN»*2  CDT2130 

?MIN=RH0Z*CNAUT*UMIN  CDT214Q 

IF  (PMIN.LT .ROEPS)  PMIN=UMIN*RH0Z*TRIAL  CDT2150 

WRITE  (6»290)  N10 #N11#T»DT» TRIAL# WSC#UMIN#PMZN  CDT2160 


69 


DTNA=DT  CDT217Q 

♦♦♦  T£i  TRrl  -  .2SRH0Z  CUI2171 

THE  PRESSURE  OF  COLO » FREE  SURFACE  CELLS  IS  REDUCED  BY  ACDT2172 
FACTORS  WHICH  ACCOUNTS  FOR  THE  EFFECT  OF  FREE  SURFACECDT2173 
LOCATION  ON  THE  PRESSURE  GRADIENT,  F  IS  THE  DENSITY  OF  CDT2174 
THE  LOWEST  DENSITY  ADJACENT  CELL  DIVIDED  BY  THE  NORMAL  CDT2175 


DENSITY»0R  F  IS  TESTRH 

WT=TESTRH 
DO  140  I=i#Il 
K=I+1 

DO  140  J=1#I2 
RHOW=AMX(K)/lDY(J)*TAU(I) ) 

WTB=WT 

IF  (AIX(K) .GL.ESESQ)  GO  TO  140 
IF  (RHOW.LT. SOLID)  GO  TO  140 
IF  U.EQ.IMAX)  GO  TO  100 
WTA-AMX(K+1)/(DY(J)*TAUU+1) ) 

IF  (WTA.LT. WT)  WTB=WTA 
IF  (I.EQ.l)  GO  TO  110 
WTA=AMX ( K-l ) / ( DY ( J ) ♦TAU ( 1-1 ) ) 

IF  (WTA.LT.WT8)  WTB=WTA 
IF  (J.EQ.JMAX)  GO  TO  120 
KA=K+IMAX 

WT A=AMX ( KA ) / ( DY ( J+l ) ♦TAU ( I ) ) 

IF  (WTA.LT, WTB)  -TB=WTA 
IF  (J.EQ.l)  GO  TO  130 
KB=K-1MAX 

WTA=AMX (KB)/ (OY ( J-l) ♦TAU ( I ) ) 

IF  (WTA.LT. WTB)  WT8=WTA 
IF  (WTB.LT.WT)  P(K)=P(K) *WTB/RHOZ 
K=K+IMAX 
GO  TO  190 


WHICHEVER  IS  SMALLEST 


NK=75 
GO  TO  180 

NK-95 
GO  TO  180 


♦♦♦  DT  TOO  SMALL 


IS  NEGATIVE 


♦♦♦  DT  WILL  BE  NEGATIVE  OR  ZERO. 


NK— 65 
GO  TO  180 

NR53 

CALL  ERROR 


♦♦♦FIND  THE  MAXIMUM  PRESSURE  ON  EACH  COLUMN  AND 


CDT2176 

CDT2180 

CDT219Q 

CDT2200 

CDT2210 

CDT2220 

CDT2230 

CDT2240 

CLJT2250 

CDT2260 

CDT2270 

CDT2280 

CDT2290 

CDT2300 

CDT2310 

CDT2320 

CDT2330 

CDT2340 

CDT2350 

CDT2360 

CDT2370 

CDT2380 

CDT2390 

CDT2400 

CDT2410 

CDT2420 

CDT2430 

CDT2440 

CDT2450 

CDT2460 

CDT2470 

CDT2480 

CDT2490 

CDT2500 

CDT2510 

CDT2520 

CDT2530 

CDT2540 

CDT2550 

CDT2560 


♦♦♦STORE  ITS  CELL  NUMBER  AS  JPM.  THIS  WILL  BE  USED  CDT2570 
♦♦♦IN  DETERMINING  THE  REGION  IN  WHICH  PHASE  3  IS  CDT2580 
♦♦♦USED.  WSM  ttXLL  BE  A  RUNNING  MAXIMUM  OF  THE  CDT2590 

♦♦♦PRESSURE  IN  I  HE  GRID.  CDT2600 

WSA=-1.E30  .  CDT2610 

DO  260  1=1 » II  CDr2620 

♦♦♦  WS  WILL  BE  LOCAL  MAXIMUM  OF  CvLUMN  I.  CDT262' 

WS=-1.E3Q  CDT2630 

K= ( 12-1 ) ♦IMAX+I+l  CDT2640 

JP=I2  CDT2650 

JINTL=1  CDT2660 
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***  START  AT  TOP  OF  COLUMN  AND  LOOK  FOR  PRESSURE  PEAK* 

DO  210  J=JINTL#I2 

Ter  /n/i/\  it  ur  \  f  a 

*r  »r  \  r\^  oui  *n^/  iw  ttw 

WS=P(K) 

♦  ♦*  Jp  7S  J-INDEX  OF  CELL  WITH  PEAK  PRESSURE. 

JP=JP-1 

K-K“IMAX 

***  IF  YOU  FALL  THROUGH # THEN  THERE  WAS  NO  MAXIMUM  IN  THIS 
COLUMN 

GO  TO  250 

***  COME  HERE  IF  PRESSURE  HAS  PASSED  A  LOCAL  MAXIMUM 
♦♦*  PTEMP  IS  PEAK  PRESSURE  OF  COLUMN  I. 

PTEMP=P(K+IMAX) 

IF  ( PTEMP. LT.WSA)  GO  TO  230 

♦♦♦  WSA  WILL  BE  PEAK  PRESSURE  IN  ACTIVE  GRID  (ABSOLUTE 
MAXIMUM) . 

WSA=PTEMP 
GO  TO  240 

♦♦♦  PTEMP  IS  LOCAL  MAXIMUM  BUT  IS  LESS  THAN  ABSOLUTE 
MAXIMUM 

IF  (PTEMP. GT.0.3*WSA)  GO  TO  240 

♦♦♦  THIS  LOCAL  MAXIMUM  IS  NOT  BIG  ENOUGH  TO  USE  FOR  JPM 
JINTL=J+1 


JP=JP-1 

♦♦♦  WE  MAY  HAVE  REACHED  BOTTOM  OF  COLUMN 
IF  (JINTL.GE.I2)  GO  TO  250 

♦♦♦  CONTINUE  DOWN  COLUMN  SEARCHING  FOR  SUFFICIENTLY  LARGE 
LOCAL  MAXIMUM. 

WS=P(K) 

K=K-IMAX 
GO  TO  200 

♦♦♦  IF  POSITION  OF  PEAK  PRESSURE.  IN  COLUMN  I  DOES  NOT 
ADVANCE  FROM  ONE  CYCLE  TO  THE  NEXT  »  DO  NOT  CHANGE 
VALUE  OF  JPM. 

JP=JP+1 

IF  (JP.LE.JPMd) )  GO  TO  260 
JPM(I)=JP 

♦♦♦IF  JPM  IS  ZERO  THE  SHOCK  HAS  NEVER  REACHED  THIS 
♦♦♦LOCATION.  IF  IT  IS  NONZERO  THE  SHOCK  HAS  PASSED 
♦♦♦AND  WE  MUST  CONTINUE  TO  INCREASE  I  UNTIL  THE 
♦♦♦RIGHT  BOUNDARY  OF  THE  SHOCK  IS  REACHED. 

IF  (JPM(I> .LE.O)  GO  TO  270 
♦♦♦  END  OF  I  LOOP. 

CONTINUE 

♦♦♦  IF  PEAK  PRESSURE  OF  COLUMN  I  HAS  GONE  BELOW  A  THIRD 
THE  GRID  MAXIMUM#  AND  IF  JPM(I)=0.  FROM  THE  PREVIOUS 
CYCLE#  WE  HAVE  REACHED  THE  RIGHT  EDGE  OF  THE  SHOCK. 

CONTINUE 

♦♦♦  JPM ( I )  MUST  BE  MONOTONIC  DECREASING 

K=I1-1 


UU | dDDD 

CDT2670 

CD i 2660 

CDT2690 

CDT2695 

CDT2700 

CDT271G 

CDT2720 

CDT2730 

CDT2740 

CDT2750 

CDT2760 

CDT2770 

CDT2760 

CDT2790 

CDT2800 

CDT2805 

CDT2810 

CDT2820 

CDT2830 

CDT2840 

CDT2850 

CDT2860 

CDT2870 

CDT2880 

CDT2890 

CDT2900 

CDT2910 

CDT2930 

CDT2940 

CDT2945 

CDT2950 

CDT2952 

CDT2954 

CDT2960 

CDT2970 

CDT2980 

CDT2982 

CDT2984 

CDT2986 

CDT2990 

CDT3000 

t;DT30l0 

CDT3020 

CDT3030 

CDT3040 

CDT3050 

CDT3060 

CDT3070 

CDT3075 

CDT3080 

CDT3090 

CDT3100 

CDT3110 

CDT3130 

CDT3140 

CDT3150 
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4* 

-i 


DO  280  IWS=1»K  CDT3160 

.r-Il-lWS  CDT3170 

IF  ( JPM ( I ) • LT  » sJPM ( 1+1 ) )  JPM<I>=JPM<I+1>  CDT3180 

RETURN  CDT3I90 

CDT3200 

FORMAT  </4H  CDT#I3»I4»4H  T=» 1PE13.7# 5H  DT=»1PE13.7#9H  MAXCUV=rlCDT3210 
1PE13.7#8H  MAXUV- # 1PE13 » 7  *  7H  UMIM=»1PE13.7»7H  PMIN=»1PE13.7)  CDT3220 

END  CDT3230- 


SURttnUTlNF  pc; 


DIMENSION  AMXC25Q2) #AIX(2502> »U(2502)  #V(25Q2)  #PC2502i 


1 

X (52)  »XX(54)  »TAU(52)  #UPM(52)  # 

ES 

50 

2 

Y (102)  ► YY ( 104)  #FLEFT(102) 

»  YAMC(102)»  SIGC(102) 

r 

ES 

60 

3 

GAMCUU2) . 

ES 

70 

4 

PK( 15) »  2(150)  » 

ES 

80 

5 

XP (26#  51 ) » YP (26#  51) » 

ES 

90 

6 

PL(204)  »UL(204)  »PR(204)  » 

ES 

100 

7 

RSN(52) »  RSI (52) » 

ES 

110 

8 

CMXP (5)  #CMYP(5)  »IJ(5)  * 

UK(5)  # 

ES 

120 

9 

"  DX(52)  fODX(54)  >DY(102)  # 

DDY (104)  » 

ES 

130 

$ 

SNB152)  »STB(52)  #UK(52»3)  » 

VK ( 52 # 3 )  #RH0(52»3) 

ES 

140 

c 

***  DIMENSIONED  ARRAYS 

ES 

150 

c 

***  Z-BLOCK  IS  SAVED  ON  TAPE. 

ES 

160 

COMMON 

Z 

ES 

170 

COMMON 

PK 

ES 

180 

COMMON 

YY  #  XX 

ES 

190 

COMMON 

OQX#  DDY 

ES 

200 

COMMON 

AMX#  AlXr  U#  V#  P 

ES 

210 

COMMON 

TAU#  UPM 

ES 

220 

COMMON 

UL  »  PL 

ES 

230 

COMMON 

XP  »  YP»  CMXPf  CMYP 

ES 

240 

c 

***  NON-DIMENSIONED  VARIABLES 

ES 

250 

COMMON 

AID  » AMMV  #AMMY  »AMPY 

» AMUR  » AMUT 

» AMVR 

» 

ES 

260 

1AMVT 

#DELEB  »DELER  »DELET  #DELM  #DTODX 

DXYMIN»EAMMP 

»EAMPY 

» 

ES 

270 

2E 

r ERDUMP# I  #13  #IWS  #J 

#K  #KA 

»KB 

# 

ES 

230 

3LL 

»MD  »ME  #MZT  #NERR  »NK 

#nprint» 

ES 

290 

4NR 

»NRZ  »NULL£  #PIDTS  »SIEMIN»SNR 

#SNT  »STR 

# SOLID 

# 

ES 

300 

5SUM 

*TESTRH»TWQPI  rURR  »WS  » WSA 

rWSB  »WSC 

#WFLA6F» 

ES 

310 

6WFLAGL 

» WFLAGP 

ES 

320 

c 

ES 

330 

c 

***  THE  FOLLOWING  EQUIVALENCES  MAKE  AVAILABLE 

ES 

340 

c 

XCQ)»  Y(0)»  DX(O) #  DY(O) 

ES 

350 

EQUIVALENCE  (XX<2)#  X(l)).  (YY<2)#  Y(l) ) 

EQUIVALENCE  CDDX(2)#  DX(1))»  <DDY(2)»  DY(1) ) 

***  SPECIAL  EQUIVALENCES  FOR  PH2  ONLY 


EQUIVALENCE 


(UL'FLEFT) # 
(PL#GAMC#PR) » 


<ULt 103) # YAMC) * 
(PL(1Q3)»SISC) 


***  SPECIAL  EQUIVALENCES  FOR  PH3  .ONLY 


EQUIVALENCE 


(UL»RSN) » 
(PL»RST) » 
(p{157) rVK) # 
(P(365)»STB)» 


(P»UK) » 

(P(313)»SNU)» 

(P(417)»RH0) 


***  SPECIAL  EQUIVALENCES  FOR  EDIT 
EQUIVALENCE  (PR(l)r  IU;  r  <PR(6)#  UK) 

***  Z-STORAGE  EQUIVALENCES 


EQUIVALENCE 


CZC  DrPROB  )#(Z(  2) » CYCLE  )» 
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f 


KZ(  3) f  QT  ) 

till 

4) 

rNUMSP 

)  » 

(Zl 

5)  r 

NFRELP) f 

(Z( 

6) »NDUMP7) 

» 

ES 

590 

2(Z(  7) » 1CSTOP) 

»(Z( 

8) 

»PI0Y 

) » 

(Z( 

9) 

» TOPMU  ) 

» (Z( 

10) »rtmu 

)  » 

ES 

600 

3(Z(  11) »STK1  ) 

»(Z( 

12) 

»NUMREZ) » 

(Z( 

13) 

»ETH  ) 

>(Z( 

14) »UN14 

) » 

ES 

610 

4(Z(  15) »RHINIT) 

»(Z( 

16) 

»PROJI 

)  » 

(ZC 

17) 

»UN17  ) 

»(Z( 

18) »XMAX 

)  f 

ES 

620 

5(Z(  19) #  NZ  ) 

>(Z( 

20) 

>NREZ 

)  t 

(Z( 

21) 

» AMDM  ) 

»(Z( 

22) #UVMAX 

)» 

ES 

630 

6(Z<  23)»UN23  ) 

»(Z( 

24) 

»DMIN 

) » 

(ZC 

25) 

» JSTR  ) 

»(Z( 

26) »DTNA 

)r 

ES 

640 

712(  27) rCVIS  ) 

» (Z( 

28) 

»STK2 

) > 

(Z( 

29) 

rSTEZ  ) 

?  (Z( 

30) »NC 

)t 

ES 

650 

8(Z(  31) f UN31  ) 

»(Z( 

32) 

»NRC 

)  » 

(Z( 

33) 

t IMAX  ) 

»(Z( 

34) t IMAXA 

), 

ES 

660 

9(Z(  35) »UMAX  ) 

r(Z( 

36) 

» JMAXA 

)  * 

<Z( 

37) 

»KMAX  ) 

»(Z( 

38) oKMAXA 

) 

ES 

670 

equivalence 

ES 

680 

i(z(  39)»B0TM  ) 

»(  Z( 

40) 

fBOTMV 

)  » 

(Z< 

41) 

rNUMSPT) 

r(Z( 

42) jCZERO 

)t 

ES 

690 

2(Z(  43) rNUMSCA) 

»(z( 

44) 

>PRLIM 

)  * 

(Z( 

45) 

»PRDELT) 

» (Z( 

46) tPRFACT) 

ES 

700 

equivalence 

ES 

710 

1(Z(  47) » 11  ) 

»(Z( 

48) 

» 12 

)  » 

<Z( 

49) 

# IPCYCL) 

»(Z( 

50) »TSTOP 

ES 

720 

2(Z(  51) rRHOFIL) 

»(z( 

52) 

*TARGV 

) » 

(ZC 

53) 

»N3  ) 

r  (Z( 

54) » IVARDY) r 

ES 

730 

3(Z(  55) » VT  ) 

>(Z( 

56) 

#N6 

)  » 

(Z( 

57) 

»RTM  ) 

t  (Z( 

58) rRTMV 

)  t 

ES 

740 

4(Z(  59)»UN59  ) 

»(z( 

60) 

»N10 

)  * 

(Z( 

61) 

t  Nil  ) 

r  ( Z  ( 

62) t GAMMA 

)  , 

ES 

750 

5(Z(  63)»T0PM  ) 

»(z( 

64) 

»B0TMU 

) » 

(Z( 

65) 

t  SN  ) 

»(Z( 

66) »TOPMV 

)  t 

ES 

760 

6(Z(  67) ?PRY0OT) 

#(z( 

68) 

»PRYTOP) » 

(Z( 

69) 

rPRXRT  ) 

»(Z( 

70) »CYCPH3) » 

ES 

770 

7(Z(  71) f REZFCT) 

»(z( 

72) 

»TARGI 

)? 

(Z( 

73) 

»PROJU  ) 

»(Z( 

74) rBBOUND) * 

ES 

780 

8(Z(  75)  EVAP  ) 

#(ZC 

76) 

>ECK 

) . 

(Z( 

77) 

»necycl) 

r  (Z ( 

78) »II 

)f 

ES 

790 

9(Z(  79)  »«JJ  ) 

r(Z( 

80) 

»NMP 

) , 

<z< 

81) 

»Y2  ) 

»(Z( 

82) rEZPHl 

) 

ES 

800 

EQUIVALENCE 

ES 

810 

KZ(  83)  *  IVARDX) 

r(Z( 

84) 

»T 

)  t 

u( 

85) 

fNMPMAX) 

»  (Z( 

86) »PMIN 

)t 

ES 

820 

2(Z(  87) i INTER  ) 

»(z( 

68) 

»TAY80T) t 

(Z( 

89) 

»TAYTOP) 

»(Z( 

90) t IEMAP 

), 

ES 

830 

3(Z(  91 ) » MC  ) 

»(Z( 

92) 

»MR 

)» 

(ZC 

93) 

»MZ  ) 

*(  Z( 

94) »MB 

) 

ES 

840 

EQUIVALENCE 

ES 

850 

1(Z(  95) f REZ  ) 

r(Z( 

96) 

»NOOUMP) » 

(Z( 

97) 

rUN97  ) 

»(Z( 

98) »UN98 

)t 

ES 

860 

2(Z<  99) »UN99  ) 

» (Z(100) 

»EVAPM 

)» 

(Z(lOl) 

rEVAPEN) 

» (Z(102) »EVAPMU) * 

ES 

870 

3(Z(103) fEVAPMV) 

r (Z  ( 104) 

»EZPH2 

)t 

(Z(105) 

»SNL  ) 

»(Z(106)>STL 

)t 

ES 

880 

4(Z(107)»TAXRT  ) 

» (Z(108) 

» IDNMAP) » 

(Z(109) 

* IPRMAP) 

i (Z(llO) rROEPS 

)? 

ES 

890 

5(Z(111) * RHINI  ) 

» (Z(ll2) 

»VINI 

)  t 

(Z(113) 

»FINAL  > 

t (Z(114) t IVMAP 

), 

ES 

900 

6CZC115) »RHOZ  ) 

»(Z(116) 

rESA 

)t 

(Z(117) 

rESEZ  ) 

r(Z(H8)»ESB 

)# 

ES 

910 

7(Z(119) »ESCAPA) 

t (Z(120) 

rESESP 

)t 

(Z(121) 

fESESQ  / 

» (Z( 122) fESES 

)  » 

ES 

920 

8(Z(123) rESALPH) 

» (Z(124) 

fESBETA) » 

(Z ( 125) 

rESCAPB) 

r (Z(126) t IUMAP 

)» 

ES 

930 

9(Z(127)».SS1  ) 

» (Z(128) 

»SS2 

)  # 

(ZC129) 

»UMIN  ) 

r (Z(130) rSS4 

) 

ES 

940 

EQUIVALENCE 

ES 

950 

1(Z(131)»PRTIME) 

»(Z(132) 

rEOR 

)  » 

(ZC133) 

rEOT  ) 

t  (Z(134) rEOB 

)» 

ES 

960 

2(Z( 135) rEMOR  ) 

«•  CZU36) 

»DXF 

)» 

(ZC137) 

»DYF  ) 

» (ZC138) >RHOMIN) » 

ES 

970 

3(Z( 139) »STAB) » 

(Z( 140) 

XIENRG) 

t 

(ZC141) 

rXKENRG) 

r  (Z(142) »XTENRG) 

»ES 

980 

4(Z(143)»S7T  ) 

»  (Z<144) 

»DTMIN 

)t 

(Z(145) 

rTRNSFC) 

t (Z(146) »EMOT 

)t 

ES 

990 

5 ( Z ( 147 ) » JPRQ  J  ) 

» (ZC148) 

»CNAUT 

)» 

(Z(149) 

»BBAP.  ) 

t (ZC150) rEMOB 

) 

ES 

1000 

ES  1010 


ES  1010 

***  special  equiv  for  es  and  cdt  ES  1012 

EQUIVALENCE  IRHOtf »NULLE)  ES  1014 

.  . . . . «... . . . .  .ES  1020 

ES  1030 

END  OF  COMMON  ES  1040 

ES  1050 

. . . ...ES  1060 

***  p(K)  CALCULATED  FROM  RHOW  AND  AlX(K>.  ES  1065 

RHOW  IS  CALCULATED  IN  CDT  ES  10?') 

ES  1073 

IF  CESCAPA.LE.O.)  GO  TO  30  ES  1110 

ETA-RHQW/RHOZ  ES  1120 

VOW=i./ETA  ES  1130 

IF  (AIX(K).LE.O.)  GO  TO  20  ES  1140 


7L 


c 


c 

10 

c 

c 

c 

c 

c 

c 

c 

c 

c 

20 

c 

c 


c 

30 

C 

40 


c 

c 

50 


C 

C 


C 

60 

C 

C 

C 


C 

c 
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***  PI  AND  P4  ARE  THERMAL  PRESSURE  TERMS. 
Pi=AIX<K)*RHOW*ESA 

P4=ESb/lAlX(K)/(ESEZ*ETA**2)+l.)*AlX(K)*RH0W 
***  PS  IS  MECHANICAL  PRESSURE  TERM 
P5=ESCAPA*( ETA-1.) 

P2=-l. 

***  IF  MATERIAL  IS  UNDER-DENSE  AND  ITS  ENERGY  IS  BETWEEN 

ESES  And  esesp,  a  combination  of  the  expanded  and 

CONDENSED  EQUATIONS  OF  STATE  IS  USED. 

IF  (ETA.GE.i.)  GO  TO  50 

***  ESESP  =  ENERGY  TO  VAPORIZE  MATERIAL.  MUST  EXCEED  ESES. 
IF  (A.X(K) .GT.ESESP)  GO  TO  40 

***  ESES  =  ENERGY  TO  BRING  MATERIAL  TO  VAPOR  TEMPERATURE. 
IF  (AIX(K) .GT.ESES)  P2=l. 

***  P2=l  MEANS  BOTH  THE  EXPANDED  AND  COMPRESSED 

FORMULATIONS  WILL  BE  USED.  OTHERWISE*  P2=-'l. 

GO  TO  50 

***  WHEN  SPECIFIC  INTERNAL  ENERGY  OF  CELL  IS  NEGATIVE* 
THERMAL  PRESSURES  ARE  SET  TO  ZERO. 

P1=Q. 

P4=0. 

***  WhEN  SPECIFIC  INTERNAL  ENERGY  IS  NEGATIVE  OR  ZERO  AND 
DENSITY  IS  LESS  THAN  SOLID r  SET  PRESSURE  TO  ZERO. 

IF  (ETAoLT « AMDM)  GO  TO  80 
GO  TO  10 

***  IDEAL  GAS 
P(K)=ESA*RHOW*AIX{K) 

GO  TO  90 

***  EXPANDED  STATE 
P8=(1.-V0W) 

P9-EXP ( ESALPH*P8 ) 

P12=EXP(-ESB£TA*P8**2) 

P(K)=P1+(P4+P5*P9)*P12 
IF  (P2.LT.0.)  GO  TO  70 
P1=SS1*(AIX(K)-ESF.S) 

P(K)=P1*P(K)+(1.“P1)*P3 
GO  TO  70 

***  CONDENSED  STATE 

Po  IS  MECHANICAL  PRESSURE  TEr\... 

P6=£SC APB*  ( .( ETA-1 .  )  **2 ) 

P(K)=P1+P4+P5+P6 
IF  (P2.LT.Q.)  GO  TO  50 

***  USING  COMBINATION  OF  CONDENSED  AND  EXPANDED  EQUATIONS 
OF  STATE. 

IF  (P(K).LT.O.)  P(K)=0. 

P3=P(K) 

GO  TO  40 

***  USING  CONDENSED  EQUATION  OF  STATE 
IF  (P(K).GE.O.)  GO  TO  90 

***  IF  MATERIAL  IS  EXPANDED  OR  J-INDEX  OF  CELL  IS  LESS 

than  ns*  set  negative  pressure  to  zero.  (N6  is  input 

PARAMETER) 

IF  (J. LE.N6.0R. ETA. LE. AMDM)  GO  TO  80 
GO  TO  90 

***  SET  NEGATIVE  PRESSURES  TO  ZERO  WHEN  USING  COMBINED 

OR  EXPANDED  EQUATIONS  OF  STATE. 

IF  (P(K).GE.O.)  GO  TO  90 


Bb  ii4b 
ES  1150 
ES  1160 
ES  1165 
ES  1170  ' 
ES  1180 
ES  1182 
ES  1J.84 
ES  1186 
ES  1190 
ES  1195 
ES  1200 
ES  1205 
ES  1210 
ES  1212 
ES  1214 
ES  1220 
ES  1222 
ES  1224 
ES  1230 
ES  1240 
ES  1242 
ES  1244 
ES  1250 
ES  1260 
ES  1265 
ES  1270 
ES  1280 
ES  1290 
ES  1300 
ES  1310 
ES  1320 
ES  1330 
ES  1340 
ES  1350 
ES  1360 
ES  1370 
ES  1380 
LS  1385 
ES  1390 
ES  1400 
ES  1410 
ES  1412 
ES  1414 
ES  1420 
ES  1430 
ES  1440 
ES  1445 
ES  1450 
ES  1452 
ES  1454 
ES  1456 
ES  1460 
ES  1470 
ES  1472 
ES  1474 
ES  1480 


SO  P(K3=0. 

90  RETURN 

END 
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SUBROUTINE  EDIT  IQ 

30 

DIMENSION  AMX<2502) »AIX(2502) »U(2502)  *V(2502)  »P( 2502)  >  40 

1  X(52)  *XX(54)  » T AU ( 52 )  *UPM(52)  »  CRAD(52)>  50 

2  T  £  102)  » YY ( 104)  »FLEFT<102)»  YAMC(102)»  SIGC<102)»  60 

3  GAMC ( 102) »  70 

K  PK(15)»  Z (150 )  »  GO 

5  XP(26»5l) » YP(26f 51) t  90 

b  PL1204)  t UL (204)  rPR(204)  »  100 

7  RSN ( 52) »  RST £ 52) »  110 

6  CMXP(5)  t CMYP (5)  »IJ(5)  rJK(5)  »  120 

9  DX  ( 52)  >DDX<54)  #DY(102)  »DDY(104)  t  130 

$  SNB<52)  f STB (52)  #UK(52»3)  >VX(52»3>  rRH0(52#3)  140 

***  DIMENSIONED  ARRAYS  150 

***  Z-3L0CK  IS  SAVED  ON  TAPE.  160 

COMMON  Z  170 

COMMON  PK  180 

COMMON  YY  t  XX  190 

COMMON  DDXr  DDY  200 

COMMON  AMX  t  AIX*  Uf  V •  P  210 

COMMON  TAU»  JPM  220 

COMMON  UL  t  PL  230 

COMMON  XP  i  Yp*  CMXP»  CMYP  240 

***  NON-DIMENSIONED  VARIABLES  250 

COMMON  AID  »AMMV  t AMMY  » AMPY  »AMUR  rAMUT  » AMVR  t  260 

1AMVT  »DELEB  /DEL£R  .DELET  »DtLM  rDTODX  rDXYMINrEAMMP  »EAMPY  »  270 

2E  »ERDUMP»I  r 13  #IWS  tJ  rK  »KA  »KB  r  280 

3LL  »MO  /ME  »MZT  *NERR  t  NK  rNPRIN'f#  290 

4NR  »NRZ  rNULLE  fPIDTS  pSIEMIN»SNR  »SNT  rSTR  rSOLID  t  300 

5SUM  »TESTRH»TWOpI  ,URR  #WS  »WSA  »WSB  fWSC  r WFLAGF»  310 

SWFLAGLf WFLAGP  320 

330 

*+*  THE  FOLLOWING  EQUIVALENCES  MAKE  AVAILABLE  340 

X£Q) #  Y ( 0 ) »  DX ( 0 ) »  DY(O)  350 

360 

EQUIVALENCE  (XX(2)»  XU)),  (YYC2),  YCl) )  370 

EQUIVALENCE  (DDX(2)>  DX<1)>»  (DDY (2) t  DY(1) )  380 

390 

***  SPECIAL  EQUIVALENCES  FOR  PH2  ONLY  400 

410 

EQUIVALENCE  (ULf FLEFT) #  (UL(103) , YAMC) ,  420 

1  (PL»GAMC»PR) »  (PL<103) »SIGC)  430 

440 

***  SPECIAL  EQUIVALENCES  FOR  PH3  ONLY  450 

460 

EQUIVALENCE  (ULrRSN),  470 

1  (PL»RST) ,  (P,UK) #  480 

2  (P(157) , VK) ,  CP(313)»SNB>,  490 

3  (P(365) »STB) »  (P(417)»RH0)  500 

510 

***  SPECIAL  EQUIVALENCES  FOR  EDIT  520 

530 

EQUIVALENCE  (PR£1>,  IU) »  <PR<6),  J K) t  (UL(103) rCRAD)  540 

550 

***  Z-STORAGE  EQUIVALENCES  560 

570 

EQUIVALENCE  (Z(  1>»PR0B  >»£Z<  2), CYCLE  )»  58. 
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***•  SPECIAL  EQUIV.  FOR  EDIT 


EQUIVALENCE  (PR(1>  pTIETAR) » (PR(2) pTKETAR) p 

1  (PR(4) pTARMAS) » (PR(5) pTARMV  )p 

2  (PR(7) pRAMOMA) p (PR(8) pPRAMOA) p 

3  (PR(lO) pTKEPRO) » (PRCll) pTEPRO) 

4  (PR(13)»PRMV  ) t (PR(14) pPRMVP) t (PR(15) pRAMOMB) p 

5  ( PR ( 16 ) p PRAMOB ) 

DIMENSION  PR0PK50) 


(PR (3)  rTETAR  » 
(PR(6) pTARMVP) p 
(PR (9) pTIEPRO) p 
t  (PR (12) pPRMAS) p 


c  1160 

C  ***  EROUMPrl.  WHEN  ERROR  CALLS  EDIT  FOR  A  TAPE  DUMP  ONLY  1162 

If  (£RD'JMP;GT;Qi )  60  TO  150  1170 

C  ***  ENERGY  SUM  (ESUM)  AND  RELATIVE  ERROR  IN  SUM  (RELERR)  1172 

C  COMPUTED.  ECK  IS  LARGEST  ERROR  COMPUTED  AND  ON  PRINT  1174 

C  CYCLES  IS  PRINTED  AND  COMPARED  TO  DMIN’  MAXIMUM  1176 

C  ALLOWABLE  ERROR.  1178 

ESUm=0.  1180 

DO  10  K=2 1 KMAX  1190 

10  ESUM=ESUM+AMX(K)*(.5*(U(K)**2+V(K)**2)+AIX(K) )  120C 

RELERR=(ESUM-ETH)/ETH  1210 

IF  l ABS t RELERR ).LT.ABS( ECK))  GO  TO  20  1220 

ECK=RELERR  1230 

NECYCL=NC  1240 

20  CONTINUE  1250 

C  ***  NPRINT  =  1  WHEN  EDIT  IS  CALLED  TO  DO  AN  INTERMEDIATE  1252 

C  PRINT.  SKIP  TESTS  ON  TIME  TO  STOP’  PRINT t  REZONE’ETC.  1254 

C  WHICH  ALREADY  HAVE  BEEN  DONE  FOR  THIS  CYCLE.  1256 

IF  'NPRINT oEQ.l)  GO  TO  190  1260 

C  ***  13=1  SIGNALS  A  SHORT  PRINT  1270 

13=1  1280 

C  ***  IF  THIS  IS  FIRST  CYCLE  OF  RUN»  WFLAGF=1.  1290 

IF  (iVFLAGF.GT .0. )  GO  TO  120  1300 

C  ***  IS  THIS  THE  TIME  OR  CYCLE  TO  STOP  EXECUTION  1305 

IF  (ICSTOP.LE.NC.AND.ICSTOP.GT.O)  GO  TO  30  1310 

IF  (T* (1 .+ROEPS) .GE.TSTOP. AND.TSTOP.GT .0. )  GO  TO  30  1320 

C  ***  SHOULD  THE  GRID  BE  REZONED  1325 

IF  ( (REZ.NE.O. oAND.REZFCT.NE.O. .AnD.NUMREZ.GT.O) .OR.SS4.NE.O. )  GO  1330 

1TO  190  1340 

C  1350 

GO  TO  40  1360 

C  ***  SET  WFLAGL=1.  TO  SAY  THIS  IS  LAST  CYCLE  OF  RUN  1370 

30  WFLAGL=I.  1380 

13=11  1390 

NPRINT=1  1400 

NUMSPT =NDUMP7  1410 

NUMSP=0  1420 

GO  TO  190  .  1430 

40  ASSIGN  140  TO  LOCA  1440 

ASSIGN  110  TO  LOCB  1450 

C  ***  ARE  WE  PRINTING  ON  TIME  OR  CYCLE  INTERVALS  1455 

IF  (PRDELT.NE.O.)  GO  TO  50  1460 

45  IF  iIPCYCL.NE.O)  GO  TO  100  1470 

GO  TO  430  1480 

C  ***  PRINTING  ON  TIME.  IS  IT  TIME  TO  PRINT  1485 

50  IF  (T*(l.+ROEPS) .GE.PRTIME)  GO  TO  70  1490 

C  ***  NO.  BUT  WILL  NEXT  CYCLE  BYPASS  THE  PRINT  TIME  1495 

IF  (PRTIME.GE.T+DT)  GO  TO  60  1500 

DT=PRTIME-T  1510 

DTNA=DT  1520 

60  GO  TO  LOCA*  (140 ’130)  1530 

C  ***  YES»  IT  IS  TIME  TO  PRINT.  NPRINT=1  FLAGS  THIS  AS  A  1532 

C  PRINT  CYCLE.  ,  1534 

70  NPRINT=1  1540 

C  ***  AVOID  TRUNCATION  1550 

T=PRTXME  1560 

C  ***  IS  IT  TIME  TO  RESCALE  PRINT  INTERVAL  1565 
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IF  CT*(1.+R0EPS) .LT.PRLIM.OK.NUMSCA.LE.O)_SO  TO  80_ 

C  ***  CHANGE  PRINT  INTERVAL  AND  THt  TIME  FOR  I  HE  NEXT 

C  RESCALING. 

PROELT=PRDELT*F'RFaCT 

PRLIM=PRLIM*PRFACT 

NUMSCA=NUMSCA-1 

C  ***  DEFINE  TIME  FOR  NEXT  PRINT. 

80  PRTIME=T+PRDELT 

IWS=(PRTIM£+.5*PRDELT)/PRDELT 

WS=1WS 

PRTIME=WS*PRD£LT 

C  ***  WILL  WE  BYPASS  TIME  TO  PRINT 

IF  (PRTIME.GE.T+OT)  GO  TO  90 
C  ***  YES?  ADJUST  DT 

DT=PRTIME-T 
OTNA=DT 

90  GO  TO  LOCB?  (110?130) 

C  ***  PRINTING  ON  CYCLES.  IS  THIS  A  PRINT  CYCLE 

1Q0  IF  (MODCNCrIPCYCL) .NE.O)  GO  TO  LOCAr  (14C?130) 

C  ***  YES.  NPRINT  =  1  FLAGS  THl'S  AS  A  PRINT  CYCLE. 

NPRINT=1 

C  ***  IS  THIS  THE  CYCLE  TO  RESCALE  PRINT  INTERVAL 

IF  (NC.LToPRLlM.OR.NUMSCA.LE.O)  GO  TO  LOCB?  (110? 130) 

C 

C  ***  YES.  MULTIPLY  NUMBER  OF  CYCLES  BETWEEN  PRINTS  BY  PRFACT 

C 

IPCYCL=INT (PRFACT) +IPCYCL 
PRLIM=PRFACT*PRLIM 
NUMSCA=NUMSCA-1 
GO  TO  LOCB?  (110?130) 

C  ***  TEST  FOR  SHORT  OR  LONG  PRINT 

C  ***  NUMSP  COUNTS  NUMBER  OF  SHORT  PRINTS  SINCE  LAST  LONG 

'  C  "  PRINT.  NUMSPT  COUNTS  NUMBER  OF  CYCLES  SINCE  LAST 

C  TAPE  DUMP. 

110  NUMSP=NUMSP+1 

NUMSPT=NUMSPT+1 

IF  ( NUMSP. NE.NFRELP)  GO  TO  190 
NUMSP=0 

C  ***  13=11  SIGNALS  A  LONG  PRINT 

120  13=11 

C  ***  PRINT  OF  RESTART  CYCLE  WILL  BE  SHORT  IF  PK(3).LT.-1. 

IF  (PK(3) .LT.-1..AND.WFLAGF.GT.0.)  13=1 
GO  TO  190 

C  ***  CHECK  FOR  ENERGY  DISCREPANCY 

130  IF  (ABS(ECK) .GT.DMIN)  GO  TO  440 
C  ***  IF  LAST  CYCLE?  REWIND  TAPE 

140  IF  (WFLAGL.EQ.O.)  GO  TO  470 
REWIND  7 
GO  TO  470 
150  NUMSPT=0 

IF  ( NODUMP. NE.O)  GO  TO  170 

BACKSPACE  7 

WS=555.0 

WRITE  (7)  WS?CYCLE?N3 
WRITE  (7)  (Z(L) ?L=1?MZT) 

WRITE  (7)  (U(K)?V(K)?AMX(K)?AIX(K)?P(K)?K=1?KMAXA) 

WRITE  (7)  X(0)?(X(K)?TAU(K)#JPM(K)?K=1?IMAX) 
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1806 

1810 

1820 

1830 

1840 

1850 

1860 

1865 

1870 

1880 

1890 

1900 

1910 

1920 

1930 

1940 

1950 

1960 

1970 

1980 

1990 

2000 

2010 

2020 
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WRITE  (7)  (Y(K) .K=0. JMAX) 

C  ***  ARE  TRACER  POINTS  BEING  GENERATED 

IF  ( Y2oGTo (-1 • ) )  GO  TO  160 

C  ***  YESo  WRITE  TRACER  POINT  COORDINATES  (XP.YP)  ON  TAPE. 

WRITE  (7)  ( (XP ( I .  J ) » YP ( I . J) #1-1* II) . J=1 » JJ) 
lou  WRITE  (7)  C OX C I ) »I=1.IMAX) 

WRITE  (7)  (DY(J) »J=1.JMAX) 

WS=666o0 

WRITE  (7)  WS.WS.WS 
WRITE  (6? 550)  NC 
IF  (WFLAGL.EQ.O.)  GO  TO  170 
END  FILE  7 
17q  CONTINUE 

IF  (ERDUMP.GT.O.)  CALL  EXIT 
GO  TO  260 
160  N-2 

GO  TO  220 

c  ***  initialize  pr  array,  temporary  storage  for  energy.mass 

c  AND  MOMENTUM  TOTALS  PRINTED  OUT. 

190  DO  200  1=1.16 

200  PRl I)=G» 

C 

C  RAMOMA=RADTAL  momentum  above  jproj 

c  ramoma=radtal  momentum  below  jproj 

c  PRAMOA=POSITIVE  RADIAL  MOMENTUM  ABOVE  JPROJ 

C  PRAM0B=P0SITIV£  RADIAL  MOMENTUM  BELOW  JPROJ 

C 

IF  UPRGJ.EQ.O)  GO  TO  180 

N=IMAX*JPROJ+l 

DO  210  K=2»N 

WS=AMX(K) 

PRMAS=PRMAS+WS 

TlEPRO=TlEPRO+WS*AlXlK) 

TKEPRO=TK£PRO+ . 5»WS* (U(K) **2+V ( K ) **2) 

WSA=WS*V(K) 

PRMV=PRMV+WSA 

IF  (WSA.GToOo )  PRMVP=PRMVP+WSA 
RAMOMB=RAMOMB+AMX ( X ) *U ( K ) 

IF  (U(K).GT.O.)  PRAMOB=PRAMOB+AMX(K)*U(K) 

210  CONTINUE 
N=N+1 

220  DO  230  K=N»KMAX 
WS=AMX(K) 

TARMAS=TARMAS+WS 

TIETAR=T1ETAR+WS*AXX(K) 

TKETAR=TKETAR+.5*WS*{U(KU*2+V(K)**2) 

WSA=WS*V(K) 

tarmv=tarmv+wsa 

IF  (WSA.GT.O.)  TARMVP=TARMVP+WSA 
R AMOM A=R AMOMA+AMX (K) *U(K) 

IF  (U(K).GToO.)  PRAMOA=PRAMOA+AMX(KI*U(K) 

230  CONTINUE 

TETAR=TIETAR+TKETAR 

tepro=tiepro+tkepro 

DO  240  J=l»8 
PR(J+16)=PR{ J)+PR( J+6) 

240  CONTINUE 


CUJU 

2035 

2040 

2045 

2050 

2060 

2070 

2080 

2090 

2100 

2110 

2120 

2130 

2140 

2150 

2160 

2170 

2172 

2174 

2180 

2190 

2200 

2210 

2220 

2230 

2240 

2250 

2260 

2270 

2280 

2290 

2300 

2310 

2320 

2330 

2340 

2350 

2360 

2370 

2380 

2390 

2400 

2410 

2420 

2430 

2440 

2450 

2460 

2470 

2480 

2490 

2500 

2510 

2520 

2530 

2540 

2550 


fil 


o  o  o  o 


f/  * 


IF  ( IMAX.GT ii)  60  TO  26  Q  2560 

2570 

***  IF  DOING  A  1-0  PROBLEM  DIVIDE  TOTALS  BY  NZ  WHERE  2580 

NZ=4** (NUMBER  OF  TIMES  THE  GRID  HAS  BEEN  REZONED. )  2585 

2590 

PROPI (1)=ETH/NZ  2600 

PROP I (2) =ECK/NZ  2610 

PROPI (4)=E2PHi/NZ  2620 

PROPI (5)=EZPH2/NZ  2630 

PROP  I  (6)=B80UND/NZ  2640 

DO  250  J-.1.24  2650 

250  PROPI (J+o)=PR(J)/NZ  2660 

PROPI (31) =BOTM/NZ  2670 

PR0PI(32)=RTM/NZ  2680 

PROPI ( 33 )=TOPM/NZ  2690 

PROPI (34)=EVAPM/NZ  2700 

PROPI (35) =EMOB/NZ  2710 

PROP I ( 3b ) =EMOR/NZ  2720 

PROPI (37) =EMOT/NZ  2730 

PROPI (38) =EVAPEN/NZ  2740 

PR0PI(39)=80TMU/NZ  2750 

PROPI (40)=RTMU/NZ  2760 

PROPI ( 41 )=TOPMU/NZ  '  2770 

PROPI (42) =EVAPMU/NZ  2780 

PROPI (43) =BOTMV/NZ  2790 

PROPI (44) =RTMV/NZ  2800 

PROPI (45) STOPMV/NZ  2810 

PROPI (46) =EVAPMV/NZ  2820 

PROPI (47) =EOB/NZ  •  2830 

PROPI (48) =EOR/NZ  2840 

PROPI (49) =EOT/NZ  2850 

WRITE  (6.530)  PROB.T.NC.PROPI  (1)  .PR0PK2)  .NECYCL.  (PROPI  ( J) .  J=4f  6)  2860 

WRITE  (6.540)  (PROPI (J) »J=7»49)  2870 

GO  TO  270  2880 

260  WRITE  (6.530)  PRQB » T , NC » ETH . ECK » NECYCL . EZPH1 . EZPH2 . BBOUND  2890 

WRITE  (6.540)  ( (PR(J) »J=1»24) »B0TM.RTM»T0PM»EVAPM.EM0B.EM0R»EM0T.E  2900 
1 V APEN . BOTMU » RTMU » TOPMU . EVAPMU » BOTMV . RTMV . TOPMV . EVAPMV . EOB » EOR . EOT )  2910 

270  WRITE  (6.580)  ( JPM( I ) » 1=1. II )  2920 

C  ***  ENERGY  TOTALS  STORED  FOR  LATER  USE  IN  TRACER  POINT  2930 

C  PLOTS.  2935 

XIENRG=PR(17)  2940 

XKENRG-PR ( 18 )  2950 

XTENRG=PR(19)  2960 

C  »**  IS  THIS  A  TAPE  DUMP  OR  REZONE  CYCLE  2965 

IF  (NUMSPT.EQ.NDUMP7.0R. (REZ.NE.O. . AND.REZFCT.NE.O. .AND.NUMREZ.GT.  -  2970 
10))  60  TO  150  2980 

C  ***  ARE  TRACER  POINTS  BEING  GENERATED  2990 

280  IF  (Y2.GT. (-1.) )  GO  TO  305  3000 

C  ***  YES.  PRINT  TRACER  POINT  COORDINATES  IN  CM.  3C02 

WRITE  (6.590)  3005 

N=0  3010 

DO  300  J=1»UJ  3020 

DO  300  1=1.11  3030 

IF  (XP(I.J) oLEoO..AND.YP(I»J) .LE.O.)  GO  TO  300  3040 

IP=INT(XP(I»J) )  3050 

JP=INT(YP(I»J))  3060 

KK=JP*IMAX+IP+2  3070 
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IF  (AMX(KK) .GT.O.)  GO  TO  290 

3080 

YO/T..I\;n. 

*  r  v  »  —  v  w 

3090 

YP(I»d>=0. 

3100 

SO  TO  300 

3110 

290 

N=N+1 

3120 

CMXP(N)=X(IP)+DX(IP+1)*(XP(I»J)-INT(XP(I»J>)) 

3130 

CmYP(N)=Y(JP)+DY(JP+1)*(YP(I.  J)-InT(YPQ.J))) 

3140 

C 

3150 

C 

***  IJ»  JK  =  THE  I  AND  J  OF  THE  CELL  THE  TRACER  POINT 

3160 

C 

ORIGINATED  IN  .  (TRACER  POINTS  CHANGE  POSITION  IN 

3170 

C 

XP  AND  YP  ARRAYS  WHEN  THEY  ARE  WEEDED  OUT 

3180 

C 

DURING  REZONE.) 

3190 

C 

3200 

1J(N)=2**(NRZ+1)*(I-1)+1 

3210 

JK IN) =2** (NRZ+1) * ( J-l ) +1 

3220 

IF  (N.LT.5)  GO  TO  300 

3230 

WRITE  (6.510)  (IJ(M)  »JK(M)  .~MXP(M)  .CMYP(M)  .M=1.N) 

3240 

N=0 

3250 

300 

CONTINUE 

3260 

IF  (N.EQ.O)  GO  TO  305 

3270 

WRITE  (6.510)  (IJ(M) .JK(M) »CMXP(M> »CMYP(M) .M=1.N) 

3280 

305 

IF  (IMAX.EQ.l)  GO  TO  370 

3290 

C 

***  PRINT  SYMBOLIC  CONTOUR  MAPS  OF  COMPRESSION.  PRESSURE. 

3292 

c 

VELOCITY.  AND  INTERNAL  ENERGY  UNLESS  DOING  A  1-D 

3294 

c 

PROBLEM. 

3296 

CALL  MAP 

3300 

c 

***  COMPUTE  CRATER  DEPTH  AND  VOLUME.  AID  SUMS  DEPTH. 

3310 

AID  =  0. 

3320 

WRITE (6. 490) 

3322 

r 

W 

***  START  AT  AXIS 

3325 

DO  330  I  =1.11 

3330 

CRAD(I)  =  .5*QXlI)+X(I-l) 

3340 

PLll)  =  0. 

3350 

UL ( I )  =  0  o 

3360 

DO  320  J  =1.12 

3370 

K=(J-1)*IMAX  +1+1 

3380 

c 

***  WS  IS  COMPRESSION 

3385 

WS  =  AMX(K)/(TAU(I)+DY(J)*RHOZ) 

3390 

IFIWS.LT* (.99) )  GO  TO  310 

3400 

GO  TO  325 

3410 

310 

AID  =  AID  +  l.-WS 

3420 

c 

**♦  NOT  AT  BOTTOM  OF  CRATER  YET 

3425 

320 

CONTINUE 

3430 

325 

IAIO  =  INT(AID) 

3440 

e 

***  UL ( I )  IS  CM.  DEPTH  OF  CRATER  IN  COLUMN  I 

3442 

c 

***  PL(I)  IS  CELL  DEPTH  OF  CRATER  IN  COLUMN  I 

3444 

UL(I)  =  Y(IAID)  +  DY(IAID+1)*(AID-FL0AT(IAID)>  -  Y(UPROJ) 

3450 

IF(UlQ)  .GT.Q.oOR.UL(I)  .LT.O.)  PL(I)  =  aid 

3460 

AID  =  0, 

3470 

330 

CONTINUE 

3480 

c 

***  PRINT  CRATER  DEPTHS 

3485 

DO  340  1=1.11 

3490 

IF(UL(I)oLT.O..OR.UL(I).6T.O.)  GO  TO  335 

3500 

GO  TO  340 

3510 

335 

WRITE16.495)  I.  PL<I)»  CRaD(I).  Ul(I) 

340 

CONTINUE 

3530 

c 

**+  COMPUTE  CRATER  VOLUME  AND  VOLUME  OF  HEMISPHERE  WITH 

3532 

* 


,  X 

i?  * 


C  RA0IUS=UU(1).  PRINT  VOLUMES  WHEN  THEY  ARE  POSITIVE. 

WSB=Q ; 

DO  345  1=1# II 
IF(UL(I> .LToOo)  GO  TO  350 
C  ***  WSB  GIVES  CRATER  VOLUME 

WSB  =  UL( I ) *TAU( I ) +WSB 
345. CONTINUE 
350  CONTINUE 

C  ***  PRINT  CRATER  VOLUME  ONLY  WHEN  GREATER  THAN  ZERO 

IF ( WSB.GT .0 • )  GO  TO  355 
GO  TO  360 

C  ***  WSC  GIVES  VOLUME  OF  HEMISPHERE 

355  WSC=2  o  0944* ( UL 1 1 ) ) **3 

WRITE(6#500)  WSB#  WSC 
360  CONTINUE 

C  ***  SHORT  PRINT  MEAN  13=1  AND  PROPERTIES  ARE  PRINTED  ONLY 

C  FOR  CELLS  IN  FIRST  COLUMN.  LONG  PRINT  MEANS  13=11  AND 

C  PROPERTIES  ARE  PRINTED  FOR  ALL  CELLS  IN  ACTIVE  GRID. 

370  DO  420  1=1 #13 
KSPACE=0 
WFLAGP=1« 

J=I2+1 

K=I2*IMAX+I+1 
DO  410  L=1»I2 
J=J-1 
K=K-IMAX 

375  IF  (AMX(K))  450# 400#380 

380  IF  (WFLAGPoEQ.O. )  GO  TO  390 

WRITE  (6»560)  IrX(D»DX(I) 

WFLAGP=0 . 

390  WS=AMX(K)/{TAU(Ii*DY(U)) 

WSA=WS/RHOZ 

WSC=P(K) 

WRITE  (6»S20)  J»U(K),V(K)»WSC»AMX(K)#WSrAlX(X)rWSArY(J) 

KSPACE=0 
GO  TO  410 

400  KSPACE=KSPACE+1 

IF  (KSPACE.GT.l)  GO  TO  410 
WRITE  ( 6 » 57 0 ) 

410  CONTINUE 
420  CONTINUE 

IF  (NPRINT.EQ.O  GO  TO  130 
ASSIGN  130  TO  LOCA 
ASSIGN  130  TO  LOCg 
IF  (PRDELT.NE.O.)  GO  TO  50 
GO  TO  100 

C  ***  PRINT  DELTA  NOT  SPECIFIED  IN  INPUT 


430 

NK=45 

GO  TO  460 

C 

*** 

ENERGY  CHECK 

440 

NK=13Q 

GO  TO  460 

C 

***  NEGATIVE  MASS 

450 

NK=375 

460 

NR=5 

call  error 

470 

WFLAGP=0. 

3534 

3540 

3550 

3560 

3565 

3570 

3580 

3590 

3595 

3600 

3610 

3615 

3620 

3630 

3640 

3645 

3650 

3660 

3670 

3680 

3690 

3700 

3705 

3710 

3720 

3730 

3740 

3750 

3760 

3770 

3780 

3790 

3800 

3810 

3820 

3830 

3840- 

3850 

3860 

3870 

3880 

3690 

3900 

3910 

3920 

3930 

3960 

3970 

3980 

3990 

4000 

4010 

4020 

4030 

4050 

4060 

4070 


84 


- 


l 


c 

49q 


'  495 
500 

510 

5*0 

550 


540 


550 

560 


570 

5o0 

590 


WFLAGF=0. 

+**  SHOULD  GRID  BE  REZONED  ON  THIS  CYCLE 
IF  ( (REZ.NE.Q. .ANO.REZFCT.NE.O. .AND.NUMKEZ.6T.0) .0k.S54.nE«u. >  GO 
ITO  480 
RE'i  URN 

call  rezone 

***  t UST  call  cdt  to  recalculate  pressures 

TnO>v=T 

dtnow=dt 

KEZ— 0  • 

SS4=0. 

call  cdt 

T=TN0>v 

dt=dtnow 

OTNA=DT 

NUMREZ=NUMREZ“1 

***  NREZ  =  NUMBER  OF  REZONES  ALLOWED  (INPUT  VALUE  OF  NUMREZ) 
NUMREZ  NUMBER  OF  REZONES  ALLOWED  MINUS  THE  NUMBER 
OF  REZONES  PERFORMED  SINCE  T=0. 


NRZ=NREZ-NUMREZ 

***  NZ  USED  IN  PRINTOUT  OF  TOTALS  FOR  1-D  PROBLEMS 
NZ=4.**NKZ 

NUMSPT =NDUMP7 
GO  TO  120 


FORMATS 

FORMAT  ( 1H0 * 17X * 35HDEPTH  OF  CRATER  MEASURED  FROM  JPR0J//12X* 1HI *5X 
1 , 18HJ  OF  CRATER  BOTTOM*  12X*  1HR*  11X*17HDEPTH  IN  CM.  DH)//> 

FORMAT  ( I13»9X»  0PF6. 1* 13X* 1PE10 .4*9X* 1PE10 «4) 

FORMAT  (//6Xr 13HCRATER  VOLUME* 11X.43HCRATER  VOLUMF  BASED  ON  12/3) 
1*  PI  *  D( 1 ) **3/7X» 1PE10o4*26X» 1PE10.4) 

FORMAT  (5(14* 14, 1P2E9.2) ) 

FORMAT  (I4»1X*1P2F.14.6*3E15.6*E14.6*E15.6»E14.6) 

FORMAT ( 8H1PR0BLEM , 6X  *  4HTIME *  8X  *  5HCYCLE *  3X  * 13HT0T . EN . THEOR . 3X  t 

1  19HMAXoREL.ERR0R-CYCLE*3X*ldHIE  SET  TO  ZER0-PH1*3X» 

2  1SHIE  SET  TO  ZER0~PH2*3X*12HPLASTIC-W0RK/1F8,4*2X*1PE13.7* 

3  3X* I4*4X* 1PE13.7*  3X* 1PE13.7* IX* 14*  6X* 1PE13.7*  8X* 1PE13.7*6X* 

4  1PE13.7/) 

FORMAT  ( 18X  *  2HIE * 14X *  2HKE *  7X » 13HT0T . EN .  ( SUM ) » 7X  *  4HMASS » 12X » 2HMV *  8 
IX* 12HMV (POSITIVE) »8X»2HMU*8X* 12HMU (POSITIVE) /11H  J.GT. JPROJ* 1P8E15 

2.7/11H  J.LEo JPROJ,  1P8E15.7/14X*  12H - *3X*12H - -* 

33X  *  12H - *  3X  *  12H - - - *  3X  *  12H - - - *  3X  *  12H - 

4 - ,  3X *  12H - *  3X  *  12H - - 3X/7H  TOTALS *4X»  IP 

58E15  c 7///9H  BOUNDARY  *  9X  *  6HB0TT0M *  9X  *  5HRI GHT  * 10X  *  3HT0P » 8X  * 12HSEVAP0 
6RATEDS//9H  MASS  0uT»2X* 1P4E15.7/11H  ENERGY  OUT* 1P4E15.7/7H  MU  OUT* 
74X*lP4E15o7/7H  MV  0UT»4X*  1P4E15.7//UH  WORK  DONE  *XP3E15.7//> 
FORMAT  (1H0//21H  TAPE  7  DUMP  ON  CYCLEI5////) 

FORMAT  (1H  ///4H  I  =I3»6X,6HR(I)  =F12.3*6X»7HDR(X)  =E14.7//3H  J8X 
1*1HU13X*1HV13X*3H  P  12X*3riAMXl2X*3HRH01lX*3HAIX12X*4HC0MPUX*2H  Z/ 
2) 

FORMAT  (1H0) 

FORMAT  (//22H  J  OF  PRESSURE-MAXIMUM/ (2515) ) 

FORMAT (//103H  TRACER  POINTS  -  INITIAL  LOCATION  IN  CELL  COORDINATES 


a  n  /» 

*tUOU 

4085 
4090 
4100 
4110 
4120 
4130 
4140 
4150 
4160 
4170 
4180 
4190 
4200 
4210 
4220 
4230 
4*40 
4250 
^  4260 
4270 
4280 
4285 
4290 
4300 
4310 
4320 
4330 
4340 
4350 
4360 
4370 
4380 
4390 
4400 
4410 
4420 
4430 
4435 
4440 
4450 
4460 
4470 
4480 
4490 
4500 
4510 
4520 
4530 
4540 
4550 
4560 
4570 
4580 
4590 
4600 
4610 
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1  (I»J)  -  CURRENT  LOCATION  IN  CM.  COORDINATES  (X»Y>//  5C4H  I'3X» 
2lHJ» 5X» 1HX» 8X» 1HY »3X) ) 

END 


4612 

4614 

462U 


woc3-40'cn-Pt>jrot-* 


SUBROUTINE  MAP 


t'  .«•  I  i  i  .••••••«•«>>•  M  • 


n  V/\»i  A  ti  W  i  r\  t.  ■"  A  A  _  A  Y  V  (  OCH9  ^  *11  (  9RflP  il 

u  VIM  MHAVC.UUC,/  ~  - - 


X(52)  » XX(54)  »TAU(52 

Y ( 102)  t YY (104)  • FLEFT ( 

GAMCC102) t 

PK(15)'  2(150)  t 

XP(26»bl) > YP(26»51 ) * 

PL(204)  t UL ( 204)  >PR(204) 

RSN(52) t  RST ( 52) * 

CMXP (5)  • CMYP (5)  »IJ(5) 

DX ( 52)  »DDX(54)  »DY(102 

SNB(52)  » STB (52)  >UK(52> 

***  DIMENSIONED  ARRAYS 
***  Z-BLOCK  IS  SAVED  ON  TAPE. 


»y (2502) 
» JPM(52) 


#P  £2502) 


f TAU(52)  »JPM(52)  » 

, FLEFT (102) t  YAMC (102) >  SISC(102)r 


» DY ( 102) 
»UK(52*3) 


» JK(5)  » 

»D0Y (104)  » 

»VK(52r3)  »RH0(52»3> 


COMMON 

Z 

COMMON 

PK 

COMMON 

YY  t 

XX 

COMMON 

DDXf 

ody 

COMMON 

AMXf 

AIX# 

COMMON 

TAU» 

JPM 

COMMON 

UL  f 

PL 

COMMON 

XP  t 

YP* 

***  NON 

-DIMEN 

COMMON 

AID 

1AMVT 


XP  r  Yp»  CMXPf  CMYP 

***  NON-DIMENSIONED  VARIABL 
aid  #ammv  • ammy 
»Q£LE8  rDELER  »DEL£T  *DELM 
»ERDUMP»I  »I3  »IWS 

»MO  i ME  »MZT  »NERR 


» AMPV  >AMUR  »AMUT 
»DTODX  »DXYMIN»EAMMP 


fURR 


» WSA 


»K  r  KA 

»NPRINT  t 
» SNT  »str 
t WSB  f wsc 


2E  »ERDUMP»I  » 13  »IWS 

2LL  »MO  i me  »mzt  »nerr  »nk  »nprint» 

4 NR  »NRZ  »NULLE  #PIDTS  #SIEMIN»SNR  »SNT  rSTR 

5SUM  iTESTRHrTWQPl  »URR  rWS  »WSA  »WSB  »WSC 
6WFLAGL»WFLAGP 

**«  the  following  equivalences  make  available 
X(0i*  Y(0)»  DX(0) t  DY(0) 

EQUIVALENCE  (XX(2)»  X(l))»  (YY(2)»  Y(1>A 

EQUIVALENCE  (DDX(2)»  DX(1))»  (DDY v2) *  DY(1); 

***  SPECIAL  EQUIVALENCES  FOR  PH2  ONLY 


» AMVR  t 
rEAMPY  t 
»KB  * 

» SOLID  r 
,»WFLAGF  t 


EQUIVALENCE 


(UL» FLEFT) r 
(PL»GAMCfPR>  » 


(UL(103) »YAMC) » 
(PL(103)»SIGC) 


***  SPECIAL  EQUIVALENCES  FOR  PH3  ONLY 


EQUIVALENCE 


(UL»RSN) t 
(PL*RST) t 
(P(157) »VK) r 
(P(365) rSTB) r 


(P,UK) r 
(P(313) • SNB ) » 
(P(417) »RHO) 


***  SPECIAL  EQUIVALENCES  FOR  EDIT 
EQUIVALENCE  (PR(1)»  IU) »  (PR(6)r  UK) 

***  Z-STORASE  equivalences 

(Z(  DfPROB  >»(Z(  2)  »CYCLE 


MAP  10 
..MAP  20 
MAP  30 
MAP  40 
MAP  50 
MAP  50 
MAP  70 
MAP  80 
MAP  90 
MAP  100 
MAP  110 
MAP  120 
MAP  130 
MAP  140 
MAP  150 
MAP  160 
MAP  170 
MAP  180 
MAP  190 
MAP  200 
MAP  210 
MAP  220 
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END  OF  COMMON  MAP104C 

MAP1050 

. . ,  * . . . . . . .  ...MAP1060 

MAP1070 

DIMENSION  VALUE *40)  MAP1080 

DIMENSION  ALE (41 )  MAP1090 

DATA  ALE/2H  *2H  .  >2H  ~*2H  A*2H  B*2H  C*2H  D*2H  E*2H  F>  MAP1100 

1  2H  S*2H  H»2H  I  »2H  U*2H  K*2H  Lr2H  M»2H  N*2H  Or  MAP1110 

2  2H  P»2H  Q»2H  R*2H  S»2H  T *2H  U»2H  V»2H  W*2H  X*  MAP1120 

3  2H  Y*2H  Z»2H  +»2H  **2H  1*2H  2*2H  3*2H  4*2K  5*  MAP1130 

4  2H  o»2H  7»2H  8»2K  9*2H  0/  MAF1140 

DIMENSION  XUMC41)  MAP1150 


c 

c 

c 

c 


10 

c 


20 


c 

c 

c 

30 


50 

60 

70 


30 


90 


HaTa 

“•n  *  n 

1 
2 

3 

4 

***  SEARCH  FOR  MINIMUM  AND  MAXIMUM  COMPRESSIONS 
TO  SCALE  COMPRESSION  MAP 


XUM/2H.  2H- .  .*  2H —  ?  2H“A ;  2H-S ;  2H-C  .  2H=D  f  2H=E  >  2H=F  r 

2H-6 #  2H-H * 2H-1 t 2H“J  *  2H-K  r  2H-L » 2H-M»  2H-N  r  2H-0 » 
2H-P :  2H-Q ;  2H“R :  2H“S ;  2K-T ,  2H-U  i  2K~V ;  2H=W  #  2H=X  , 
2H-Y 1 2H-Z  > 2H-+ • 2H-*  *  2H-1 » 2H-2  *  2H-3 1 2H-4  * 2H-5 1 
2H-6 1 2H“7 1 2H“8 1 2H“9 1 2H  0/ 


IDL=I1 

JDL=I2 

IF  (NC.NE.O)  GO  TO  10 
IDL=M1N0(IMAX»55) 

UDL=UMAX 

WSMAX=G, 

WSMIN=1Q « 

00  20  J=1»JDL 
K=(J-1)*IMAX+1 
DO  20  I=l»IOL 
K=K+1 

WSA=AMX ( K ) / ( TAU ( I ) *DY i U) *RHOZ ) 

IF  ( WSAoEQe 0 • )  GO  TO  20 
WSMAX-AMAX1 ( WSMAX , WSA ) 

WSMIN=AMIN1(WSMIN*WSA) 

CONTINUE 

IF  (WSMIN.LT. WSMAX)  GO  TO  30 
WSMIN=0. 

***  DEFINE  LINEAR  SCALE  FACTOR  AND  PRINT  KEY  TO 
COMPRESSION  MAP. 

DSC ALE- (WSMAX-WSMIN) /FLOAT (IDNMAP) 

IF  (<AlNT(DSCAL£*l0Q.)).LT.<OSCALE*100.n  GO  TO  50 
DSCAL£=AINT(DSCALE*100,)/100. 

GO  TO  60 

dscale=a:nt(qscale*ioo.+i.)/ioo. 

CONTINUE 

DO  70  1=1 r IDNMAP 

VALUE ( I ) =WSMIN+FLOAT ( I ) *oscale 

WRITE  (6»Q6Q) 

ILIM1=1 

ILIM2=20 

IF  ( IDNMAP.LT. ILIM2)  ILIM2=IDNMAP 
WRITE  (6f 870)  ( ALE ( 1+1 ) » I=ILIM1 t ILIM2) 

WRITE  (6? 960 )  (VALUE(I) f I  =  ILIM1»ILIM2) 

IF  ( IDNMAP C-EQ.ILIM2)  GO  TO  90 

ILIM1=ILIM2+1 

It.lM2=ILIM2+20 

GO  TO  80 

CONTINUE 


MAPI 160 
MAP1170 
MAP1160 
MAP 1190 
MAP1200 
MAP1210 
MAP1220 
MAP1230 
MAP124C 
MAP1250 
MAP1260 
MAP1270 
MAP1280 
MAP1290 
MAP1300 
MAP1310 
MAP1320 
MAP1330 
M/..^1340 
MAP1350 
MAP1360 
MAP1370 
MAP1380 
MAP1390 
MAP1400 
MAP1410 
MAP1420 
MAP1430 
MAP1440 
MAP1480 
MAP1485 
MAP1510 
MAP1520 
MAP1530 
MAP1540 
MAP1550 
MAP1560 
MAP1570 
MAP1580 
MAP 1590 
MAP1600 
MAP1610 
MAP1620 
MAP1630 
MAP1640 
MAP1650 
MAP1660 
MAP 1670 
MAP1680 
MAP1690 


WRITE  (6r 980) 
r 

U=JDL 

100  K=(J-1)*IMAX+1 

C 

do  isyo  1=1  *  IDL 


MAP1700 

MAP1710 

MAP1720 

MAP1730 

MAP1740 

MAP1750 


no 

c 


120 


C 

140 

140 

150 

C 


160 

170 

C 


C 

*  C 
C 
C 

*  c 


160 


C 


C 


C 

190 


210 
-  220 


K=K+1 

IF  (AMX(K) .GT.O.)  GO  TO  110 
GO  TO  130 

WSA=AMX(K)/(TAU(I)*DY(U)  ilOZ) 

IF  IWSAoGT.WSMlN)  GO  TC  .20 

***  PRINT  A  DOT  TO  REPRESENT  SMALLEST  COMPRESSION. 

MA"*2 

GO  TO  140 

TMA= ( WSA-WSMIN) /DSCALE+1 . 

MA-TMA 

IF  IWSA.GT.FL0AT(MA-1)*DSCALE+WSMIN)  MA=MA+1 
GO  TO  140 

***  PRINT  A  BLANK  FOR  EMPTY  CELLS. 

MA~1 

PR(I)=ALE(MA> 

CONTINUE 

***  PRINT  J-VALUE  ALONG  Y-AXIS  WHEN  IT  IS  A  MULTIPLE  OF  5. 
IF  (MOD (Ur 5) .NE.O)  GO  TO  160 
WRITE  (6r380)  Ur (PR( I ) *  1=1 » IDL) 

GO  TO  170 

WRITE  (6r890)  (PR ( I > r 1=1 r IDL) 

U=U-1 

IF  (U.GT.O)  GO  TO  100 

***  PRINT  AND  LABEL  X-AXIS  OF  MAP. 

PR(1)=ALE(30) 

WRITE  (6r880>  U r (PR ( 1 ) » 1=1 r IOL) 

WRITE  (6r900)  (Ir 1=0, IDL»5’ 

***  SEARCH  FOR  MINIMUM  AND  MAXIMUM  PRESSURES 
TO  SCALE  PRESSURE  MAP 

WSMAX=0. 

DO  180  U=1 r  UDL 
DO  lt>0  1=1 r IDL 
K= (U-l >  *IMAX+I+1 
WSA=ABS(P(K) ) 

IF  (WSA.EQ.O.)  GO  TO  180 
WSMAX=AMAX1 ( WSMAX , WSA ) 

CONTINUE 
WSMIN=10.*PMIN 
WRITE  (6r910) 

***  PRINT  KEY  TO  MAP  ONLY  IF  THERE  ARE  NON-ZERO  PRESSURES. 
IF  (WSMAX a NE.O. )  GO  TO  190 
U-JDL 
GO  TO  260 

***  DEFINE  LOGARITHMIC  SCALE  FACTOR  AND  PRINT  KEY  TO 
PRESSURE  MAP. 

MAX£XP=INT(ALOG10(WSM;X) ) 

MINEXP=INT(ALOG10(WSMIN) ) 

PSCLE=FLOAT (MAXEXP-MINEXP+1) /FLOAT ( IPRMAP) 

IF  l ( AINT (PSCLE*lQGQ. ) ) »LT. (PSCLE*1000, ) )  GO  TO  210 
PSCLE=AINT(PSCLS*1GQQ.}/1000. 

GO  TO  220 

PSCLE=A  I  NT  ( PSCLE*1 0  0  0  .  >  O  / 1 0  0  0  . 

CONTINUE 


1’iHr  «.  i  w 

MAP1770 

MAP1780 

MAP1790 

MAP1800 

MAP1805 

MAP1810 

MAP 1820 

MAP1830 

MAP1840 

MAP1850 

MAP186Q 

MAP1865 

MAP 1870 

MAP1880 

MAP1890 

MAP1895 

MAPI 900 

MAP1910 

MAP1920 

MAP1930 

MAP194G 

MAP1950 

MAP1960 

MAP1970 

MAP1980 

MAP1990 

MAP2000 

MAP2010 

MAP2020 

MAP2030 

MAP2040 

MAP2050 

MAP2060 

MAP2070 

MAP2080 

MAP2090 

MAP2100 

MAP2110 

MAP2120 

MAP2130 

MAP214G 

MAP2145 

MAP2150 

MAP21  .0 

MAP217U 

MAP2180 

MAP2220 

MAP2230 

MAP2240 

MAP2250 

MAP2260 

MAP2270 

MAP2280 

MAP2290 

MAP2300 

MAP2310 


90 


V 


25  0 


240 


25u 

C 

260 

C 


C 


270 

C 


280 


290 

C 

300 

310 

C 

320 

C 


330 


C 


C 

C 

C 

C 

C 

C 


DO  230  1=1 i IPRMAP 
VALul i I ) -10 • ** v  MINEXRt 


J71  r\  »  T  /  t  \  a,OC/'l  C  \ 

r  j  \  x  •  **■» 


ILIK1=1 


ILIH2=10 

IF  ( IPRMAP. LT.ILIM2)  ILIM2=IPRMAP 

WRITE  (6>920)  (ALE( 1+3) » I=ILIM1» ILIM2) 

WRITE  ( 6>  970 }  { VALUE  ( I )  t  I=ILIM1 1  I|_IM2> 

IF  ( IPRMAP. EQ.ILIM2)  GO  TO  250 

ILIM1=ILIM2+1 

ILIM2=ILIM2+10 

GO  TO  240 

CONTINUE 

WRITE  (6»980) 


J=JDL 

K=lJ-l)*IMAX+l 

DO  320  I=lrlDL 
K=K+1 

IF  (AMXCts)  *GT.0o )  GO  TO  270 

***  PRINT  A  BLANK  FOR  EMPTY  CELLS. 

MA=1 

GO  TO  310 

IF  (P(K)oNEoO.)  GO  TO ■ 280 

***  PRINT  A  ZER-0  FOR  NONEMPTY  CELLS  WITH  ZERO  PRESSURE. 

MA=41 
GO  TO  310 

FLOTMA= ( ALOGIO ( A6S ( P  (K) ) ) -FLOAT(MINEXP) > /PSCLE+3. 
INTMA=INT(FL0TMA) 

IF  (FLOTMA.GT.FLOAT(INTMA) )  GO  TO  290 

MA=INTMA 

GO  TO  300 

MA-INTMA+1 

***  DO  NOT  USE  DOT  AND  DASH  IN  PRESSURE  MAP. 

IF  (MAoLE.3)  MA=4 

CONTINUE 

PR(I)=ALE(MA) 

***  USE  XUM  ARRAY  OF  SYMBOLS  FOR  NEGATIVE  PRESSURES* 

IF  (P(K)oLT.O.)  PRU)=XUMCMA) 

IF  ( MOD ( J » 5 ) . NE • 0 )  GO  TO  330 
WRITE  (6»880)  J» (PR(I) »I=1»IDL) 

GO  TO  340 

WRITE  (6» 890 )  (PR ( I ) 1 1=1 » IDL) 

J=J-1 

IF  (J.GT.O)  GO  TO  260 

***  PRINT  AND  LABEL  X-AXIS  OF  MAP. 

PR(1)=ALE(30) 

WRITE  (or  880 )  U» (pR(l) 1 1=1* IDL) 

WRITE  (6»900)  ( I • 1=0 1 IDL» 5) 

***  SEARCH  FOR  MINIMUM  AND  MAXIMUM  RADIAL 
VELOCITIES  TO  DEFINE  SCALE  FACTOR  OF 
RADIAL  VELOCITY  MAP 

WSMAX=0. 


MAP2320 
MAP2330 
MAP2340 
MAP2350 
MAP2360 
MAP2370 
MAP2380 
MAP2390 
MAP2400 
MAP2410 
MAP2420 
MAP2430 
MAP2440 
MAP2450 
MAP2460 
MAP2470 
MAP248C 
MAP2490 
MAP2500 
MAP2510 
MAP2515 
MAP2520 
MAP2530 
MAP2540 
MAP2545 
MAP2550 
MAP2560 
MAP2570 
MAP2580 
MAP2590 
MAP250Q 
MAP26*  0 
MAP2620 
MAP2625 
MAP2630 
MAR2640 
MAP2650 
MAP2655 
MAP2660 
MAP2670 
MAP2680 
MAP269G 
MAP2700 
MAP2710 
MAP2720 
MAP2730 
MAP2740 
MAP2750 
MA°276C 
MAP2770 
MAP2780 
MAP2790 
MAP2800 
MAP2810 
MAP2820 
MAP2830 
MAP284Q 
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00  350  J=1 * JDL 

MAP2850 

r»n  "iiin  i -  i  .  ini 

V\f «  4k -  *  r  •  W*» 

MAP2660 

K=( J-1)*IMAX+I+1 

MAP2870 

WSA=A8S(U(K) ) 

MAP2880 

IF  USA.EQ.O.)  GO  TO  350 

MAP2890 

WSMAXSAMAXl ( WSMAX#  WSA ) 

MAP2900 

360 

CONTINUE 

MAP2910 

WSMIN=iO.*UMlN 

MAP2920 

WRITE  (6*930) 

MAP2930 

C 

***  print  key  TO  MAP  only  if  THERE 

ARE  NON-ZERO 

VALUES. 

MAP2935 

IF  (wSMAX. NE.O,)  GO  TO  360 

MAP2940 

J=JDL 

MAP2950 

GO  TO  430 

MAP2960 

c 

MAP2970 

c 

MAP3020 

c 

***  USCLE  IS  LOGARITHMIC  SCALE  FACTOR 

OF  RADIAL 

VELOCITY 

MAP3030 

c 

MAP. 

MAP3040 

360 

MAXEXP-INT ( ALOGIO ( WSMAX) ) 

MAP3050 

MIN£XP=INT(ALOG10(WSMIN) ) 

MAP3060 

USCLE=FLOAT ( MAXEXP-MINEXP+1 ) /FLOAT ( IUMAP ) 

MAP3070 

IF  ( (AlNT(UbCL£*lOOO. ) ) «LT » (USCLE+1000. ) ) 

GO 

TO  380 

MAP3080 

USCLE=AINT (USCLE*1Q00 . ) /1000 . 

MAP3090 

60  TO  390 

MAP3100 

3o0 

USCLE=AINT(USCLE*10Q0.+1.)/1Q0G. 

MAP3110 

390 

CONTINUE 

MAP3120 

C 

***  print  key  to  map. 

MAP3125 

DO  400  1=1 * IUMAP 

MAP3130 

400 

VALUE ( I ) =10 . ** ( MINEXP+FLOAT ( I ) *USCL£ ) 

MAP3140 

ILIM1=1 

MAP3150 

IHM2=10 

MAP3160 

410 

IF  ( IUMAP. LT.ILIM2)  ILIM2=IUMAP 

MAP3170 

WRITE  (6*920)  (AlEUO)  * IsILIMlf  ILIM2) 

MAP3180 

WRITE  (6.970)  ( VALUE ( I ) * ISlLlMl * ILIM2) 

MAP3190 

IF  ( IUMAP. EQ.ILIM2)  GO  TO  420 

MAP3200 

ILIM1=ILIM2+1 

MAP3210 

ILIM2=ILIM2+10 

MAP3220 

GO  TO  410 

MAP3230 

42q 

CONTINUE 

MAP3240 

WRITE  (6*980) 

MAP3250 

C 

MAP3260 

J=JUL 

MAP3270 

430 

K=(J-1)*1MAX+1 

MAP3280 

C 

MAP3290 

00  490  1=1  * IDL 

MAP3300 

K=K+1 

MAP3310 

IF  IAMX(K) .GT.O.)  GO  TO  440 

MAP3320 

C 

***  EMPTY  CELL. 

MAP3325 

ma=i 

MAP3330 

GO  TO  460 

MAP3340 

440 

IF  (UlK) cNE.O.)  GO  TO  450 

MAP3350 

C 

***  ZERO  RADIAL  VELOCITY. 

MAP3355 

MA=41 

MAP3360 

GO  TO  480 

MAP3370 

460 

FLOTMA= ( ALOGIO ( A6S ( U ( K ) ) ) -FLOAT ( MINEXP ) ) /USCLE+3 . 

MAP3380 

INTMA=INT(FL0TMA) 

MAP3390 

IF  (FLOTMA.GT. FLOAT ( INTMA) )  GO  TO  460 

MAP3400 

MA=INTMA 

MAP3410 

GO  TO  470 

MAP3420 

4o0 

ma=inTma+i 

WAT.7/1  ctn 
»*>nr 

C 

***  JO  NOT  USE  DOT  OR  DASH  IN  RADIAL  VELOCITY  MAP, 

MAP3435 

u  y  i» 

1C  Ivia.l  O  ,V,A=U 

ll  ft  A 

ri«r  o*t*vu 

4oO 

CONTINUE 

MAP3450 

PR(I)=AL£(MA) 

MAP3460 

C 

***  USE  XUM  ARRAY  FOR  NEGATIVE  RADIAL  VELOCITIES. 

MAP 34 65 

490 

IF  (U(K).LT.O.)  PR ( I ) -XUM ( MA > 

MAP3470 

C 

***  PRINT  J-VALUE  ALONG  Y-AXIS  WHEN  IT  IS  A  MULTIPLE 

MAF3480 

C 

OF  5. 

MAP3485 

IF  (M0D(J»5) ,NE.0)  GO  TO  500 

MAP3490 

WRITE  (6*860)  J* (PR(I) *I=1*IDL) 

MAP3500 

GO  TO  510 

MAP3510 

5uo 

WRITE  (6*890)  ( PR ( I ) *  1  =  1  *  IDL) 

MAP3520 

510 

U=J-1 

MAP3530 

IF  (J.GT.0)  GO  TO  430 

MAP3540 

C 

***  PRINT  AND  LABEL  X-AXIS  OF  MAP. 

MAP3550 

PR(1)=ALE(30) 

MAP3560 

WRITE  (6*880)  J* (PR(1) *I=1*IDL) 

MAP3570 

WRITE  (6*900)  ( I  *  1=0 * IDL*  5) 

MAP3580 

C 

MAP3590 

C 

***  SEARCH  FOR  MINIMUM  AND  MAXIMUM  AXIAL 

MAP3600 

C 

VELOCITES  TO  DEFINE  SCALE  FACTOR  OF 

MAP3610 

C 

AXIAL  VELOCITY  MAP 

MAP3620 

c 

MAP3630 

W5MAX-0 • 

MAP3640 

c 

MAP3650 

DO  520  U=l*JuL 

MAP3660 

DO  520  1=1* IDL 

MAP3670 

K= ( J— 1 ) +1MAX+I+1 

MAP3680 

wSA=ABS(V(K) ) 

MAP3690 

IF  (w'SA.EQ.G.)  GO  TO  520 

MAP3700 

WSMAX=AMAX1(WSMAX»WSA> 

MAP3710 

sag 

CONTINUE 

MAP3720 

WSMIN=10,*UMIN 

MAP3730 

WRITE  (6*940) 

MAP3740 

c 

***  PRINT  KEY  TO  MAP  ONLY  IF  THERE  ARE  NON-ZERO  VALUES. 

MAP3745 

IF  ( WSMAX.NE.O. )  GO  TO  530 

MAP3750 

vJ=UDL 

MAP3760 

DC  TO  600 

MAP3770 

c 

MAP3780 

c 

KAP3820 

c 

***  VSCLE  IS  LOGARITHMIC  SCALE  FACTOR  FOR  AXIAL  VELOCITY 

MAP3830 

c 

MAP. 

MAP3840 

550 

MAX£XP=INT(ALOGlO(WSMAX) > 

MAP3850 

M I NEXP= I NT ( AlOGI 0 ( WSM IN)) 

MAP3860 

VSCLE=FLOAT (MAXEXP-MINEXP+i ) /FLOAT ( I VMAP) 

MAP3870 

IF  ( (AINT(VSCLE*1000.) ) .LT. ( VSCLE*iQQO. ) )  GO  TO  550 

MAP3880 

vscle=aint(vscle*iooc»)/iooo. 

MAP3890 

GO  TO  560 

MAP3900 

550 

VSCLE=AINT(VSCL£*1000.*-1.)/1000. 

MAP3910 

5oQ 

CONTINUE 

MAP3920 

C 

***  PRINT  KEY  TO  AXIAL  VELOCITY  MAP. 

MAP3925 

DO  570  1=1* I VMAP 

MAP3930 

570 

VALUE ( I ) =10 . ** (MINEXP+FLOAT ( I ) *VSCLE) 

MAP3940 

ILIM1=I 

MAP3950 

ILIM2=10 

MAP3960 

93 


500 


590 

C 

600 

C 


C 


610 

C 


620 


630 

C 

640 

650 

C 

660 

C 


670 

680 

C 


C 

C 

c 

c 

c 


IF  ( IVMAP.LT. ILIM2)  ILIM2=IVMAP 
WRITE  (6*920)  (AL£( 1+3) * I=ILIMi* IlIM2> 

WRITE  (6*970)  (VALUE(I) * I=ILIM1 * ILIM2) 

IF  ( IVMAP.EQ. ILIM2)  60  TO  590 

ILIM1=ILIM2+1 

IHM2=ILIM2+10 

GO  TO  580 

CONTINUE 

WRITE  (6*980) 

J=JDL 

K=(J-1)*IMAX-H 

00  660  1=1* IDL 
K=K+1 

IF  (AMX(K) .GT.O.)  60  TO  610 
***  EMPTY  CELL. 

MA=1 

GO  TO  650 

IF  (V(K).NE.O.)  60  TO  620 

***  ZERO  AXIAL  VELOCITY. 

MA=41 
GO  TO  650 

FLOTMA=(AL0610(At)S(V(K)  )) -FLOAT (MINEXP) ) /VSCLE+3. 
INTMA=INT(FL0TMA) 

IF  (FLOTMA.GT.FLOAT(INTMA) )  60  TO  630 

MA=INTMA 

60  TO  640 

MA=INTMA+1 

***  DO  NOT  USE  DOT  OR  DASH  IN  AXIAL  VELOCITY  MAP. 

IF  (MA.LE.3)  MA=4 

CONTINUE 

PR(I)-AL£(MA) 

***  USE  XUM  ARRAY  FOR  NEGATIVE  AXIAL  VELOCITIES. 

IF  (V(K).LT.O.)  PR(I)=XUM(MA> 

*♦*  PRINT  J-VALUE  ALONG  Y-AXIS  WHEN  IT  IS  A  MULTIPLE  OF  5. 
IF  ( MOD ( J * 5 ) • NE * 0 )  60  TO  670 
WRITE  (6*880)  J* (PR ( I ) *  1=1  * 1DL) 

GO  TO  680 

WRITE  (6*890)  (PR( I ) » 1=1* IDL) 

Jrj-1 

IF  (J.GT.O)  GO  TO  600 

***  PRINT  AND  LABEL  X-AXIS  OF  MAP. 

PR(1)=ALE(30) 

WRITE  (6*880)  J* (PR( 1 ) *  1  =  1  * IDL) 

WRITE  (6*900)  ( I » 1=0 » IDL* 5) 

***  SEARCH  FOR  MINIMUM  AND  MAXIMUM  SPECIFIC  INTERNAL 
ENERGIES  TO  DEFINE  SCALE  FACTOR  OF.  ENERGY  MAP 


wskax=o. 

00  690  J=1 * JDL 
00  690  1=1* IDL 
K=(J-1)*IMAX+I+1 
WSA=ABS(AIX(K)) 

IF  (WSA.EQ.O.)  GO  TO  690 


MAP3970 

MAP3980 

MAP3990 

MAP4000 

MAP4010 

MAP4020 

MAP4030 

MAP4040 

MAP4050 

MAP4060 

MAP4070 

MAP4080 

MAP4090 

MAP4100 

MAP4110 

MAP4120 

MAP4125 

MAP4130 

MAP4140 

MAP4150 

MAP4155 

MAP4160 

MAP4170 

MAP4180 

MAP4190 

MAP4200 

MAP4210 

MAP4220 

MAP4230 

MAP4235 

MAP4240 

MAP4250 

MAP4260 

MAP4265 

MAP4270 

MAP4280 

MAP4290 

MAP4300 

MAP4310 

MAP4320 

MAP4330 

MAP4340 

MAP4350 

MAP4360 

MAP4370 

MAP4380 

MAP4390 

MAP4400 

MAP4410 

MAP4420 

MAP4430 

MAP4440 

MAP4450 

MAP4460 

MAP4470 

MAP4480 

MAP4490 


<i SMAX— AHAXi  v  riSMAX  t  riSA ) 

&a  x  r\i  1  c  n  n 
nnr  *r«*/v  w» 

690 

continue 

MAP4510 

»  SM I N-  i  0  •  -r-S  I  EM  I N 

UAn/iCon 

nnr  w 

WRITE  (6/950) 

MAP4530 

C 

***  print  key  to  map  only  if  there 

ARE  NON-ZERO  VALUES. 

MAP4535 

IF  (WSMAX.NE.O.)  GO  TO  700 

MAP4540 

J=JOL 

MAP4550 

GO  TO  770 

MAP4560 

C 

MAP4570 

C 

MAP4610 

C 

***  ESCLl  IS  LOGARITHMIC  SCALE 

FACTOR  FOR  INTERNAL  ENERGY 

MAP4620 

C 

MAP. 

MAP4630 

700 

MAXEXP=1NT(ALOG10(WSMAX> ) 

MAP4640 

MINEXP=INT ( ALOGlO ( WSMIN) ) 

MAP4650 

LSCLE=FLOAT (MAXEXP-MINEXP+ 1 ) /FLOAT ( IEMAP) 

MAP4660 

IF  ( (AINT (ESCLE*i000. ) ) »LT • (ESCLE*1000 

.)) 

GO  TO  720 

MAP4670 

ESCLE=AINT(ESCLE*1000.)/1000. 

MAP4680 

GO  TO  730 

MAP4690 

720 

ESCLE=AINT(ESCLE*100Q.+1. 5/1000. 

MAP4700 

C 

***  PRINT  KEY  TO  INTERNAL  ENERGY  MAP. 

MAP4705 

7o0 

CONTINUE 

MAP4710 

UO  740  1=1 /IEMAP 

MAP4720 

740 

VALUE  ( I )  =.10 .  ■**  ( MINEXP+FLOAT  ( I )  *£SCLE ) 

MAP4730 

ILIM1=1 

MAP4740 

ILIM2=10 

MAP4750 

7d0 

IF  ( IEMAP.LT. ILIM2)  ILIM2=IEMAP 

MAP4760 

WRITE  (6/920)  (ALE(I+3) /I=ILIM1/ILIM2) 

MAP4770 

WRITE  (6/970)  (VALUE(I) /I=ILIM1»ILIM2) 

MAP4780 

IF  ( IEMAP. EQ.ILIM2)  GO  TO  760 

MAP4790 

ILIM1=ILIM2+1 

MAP4800 

JLIM2=IHM2+10 

MAP4810 

GO  TO  750 

MAP482C 

7oU 

CONTINUE 

MAP4830 

WRITE  (6/980) 

MAP4840 

y* 

V* 

MAP4850 

J=JQL 

MAP4860 

77u 

K=(J-1)*IMAX+1 

MAP4870 

C 

MAP4880 

DO  630  1=1 / IDL 

MAP4890 

K=K+1 

MAP49C0 

IF  (AMX(K) .GT.O.)  GO  TO  780 

MAP4910 

C 

***  EMPTY  CELL. 

MAP4915 

MA=1 

MAP4920 

GO  TO  820 

MAP4930 

760 

IF  (AIX(K) ,NE.O.)  GO  TO  790 

MAP4940 

y 

V 

***  ZERO  INTERNAL  ENERGY. 

MAP4945 

MA=4i 

MAP4950 

GO  TO  820 

MAP4960 

79Q 

FLOTMA=(ALOGlO(AuS(AIX(K) ) )-FLOAT (MINEXP) 5/ESCLE+3. 

MAP4970 

INTMA=INT(FL0TMA) 

MAP4980 

IF  ( FLOTMA.GT. FLOAT ( INTMA ) )  GO  TO  800 

MAP4990 

ma=intma 

MAP5000 

GO  TO  810 

MAP5010 

600 

ma=intma+i 

MAP5020 

r* 

V. 

***  DO  NOT  USE  DOT  AND  DASH  IN 

INTERNAL  ENERGY  MAP. 

MAP5025 

6iO 

IF  (MA.LE.3)  MA=4 

MAP5030 

6<;0 

CONTINUE 

MAP5040 

95 


PR(I)=AL£(MA) 

850  IP  (AIX(K) .LT.O. )  PR ( I ) =XUM(MA) 

C  ***  PRINT  J-VALUE  ALONG  Y-AXIS  WHEN  It 

IF  (MOD( J*5) «N£.0)  GO  TO  840 
WRITE  (6*880)  Jr (PR( I ) *  1=1* 1DL) 

GO  TO  850 

840  WRITE  (6*890)  (PR( I ) » 1=1  * IOL) 

850  J=J-1 

IF  (J.GT.Q)  GO  TO  770 

C  ***  PRINT  AND  LABEL  X-AXIS  OF  MAP. 

PRll)=AL£(30) 

WRITE  (6*880)  J*  (PRO.)  *  I=1*IDL) 

WRITE  (6*900)  ( I » 1=0 * IDL* 5) 

C 

C 

RETURN 

C 

C  ***  FORMATS 

8oQ  FORMAT  ( iHl *4X* 15HC0MPRESSI0N  //) 

8/0  FORMAT  ( 16H  SYMBOL  »20(3Xf42>> 

880  FORMAT  (I10*2H  I*54A2) 

89o  Format  (iox*2h  i*54A2) 

9u0  FORMAT  (112*10110////) 

910  FORMAT  (1H1*4X»15hPRESS‘JRE  //) 

920  FORMAT  (16H  SYMBOL  *  10 (3Xr A2» 5X) ) 

950  FORMAT  (1H1*4X»15hRADIAL  VELOCITY//) 

9ho  format  (ihi*4X*15haxial  velocity  //) 

950  FORMAT  (1H1»4X*15hINTERNAL  ENERGY//) 

9o0  FORMAT  (16H  MAXIMUM  VALUE  »20(F5.2)) 

970  FORMAT  (16H  MAXIMUM  VALUE  »1P10E1Q,2) 

980  FORMAT  (//) 

END 


MAP5060 

—  m  am*  rr  ^  r*  rr  uflftcn*7fi 

1Z>  M  numirut-  vr  r  mrju-w 

MAP5C80 

MAP5090 

MAP5100 

MAP5H0 

MAP5120 

MAP5130 

MAP5140 

MAP5150 

MAP5160 

MAP5170 

MAP5180 

MAP5190 

MAP5200 

MAP5210 

MAP5215 

MAP5220 

MAP5230 

MAP5240 

MAP5250 

MAP5260 

MAP5270 

MAP5280 

MAP5290 

MAP5300 

MAP5310 

MAP5320 

MAP5330 

MAP5340 

MAP5350- 


oooooo  ooo  ooo  o  o  o  o  o  oo  o  o 


SUDKUUliNE  PMi 


PHI  10 
.PHI  20 


DIMENSION  AMX<25U2> »AlX(2502) >U(25Q2)  * 

1  X(52)  .XX(54)  »  TAU  (52?  r 

2  Y (102)  » YY (104)  .FLEFT (102) 

3  GAmC ( 1 J2) » 

4  PK(15>»  2(150)  '  ♦ 

5  XP(26»5l) . YP(26.5l) . 

b  PK2U4)  .UL(204)  »PR(204)  . 

7  RSNC52).  RST ( 52)  » 

6  CMXP(5)  .CMYP(5)  »IJ(5>  t 

9  DX ( 52 )  .1>DX(54)  »DY(102>  » 

5  SNb (52)  . STB ( 52)  #UK(52.3)  t 

***  DIMENSIONED  ARRAYS 


V (2502)  >P(2502)  » 

DPM(52)  » 

.  YAM*'  1 102) »  SIGC ( 102)  » 


JK (5)  . 

DDYU04)  » 

VK<52.3)  »RH0(52.3> 


***  SPECIAL  EQUIVALENCES  FOR  PH2  only 


EQUIVALENCE 


(ULfFLEFT) > 
(PL»GAMC.PR> t 


(UL(103) rYAMC) » 
(PL(103) >SIGC) 


***  SPECIAL  EQUIVALENCES  FOR  PH3  ONLY 


EQUIVALENCE 


1 

2 

3 


(UL>  RSN) » 
(PL'RST) . 
(P(157>  »VK) » 
(P(365) .STB) . 


(P»UK) . 
(P(313) »5NB) . 
(P(417) rRHO) 


-ru 

Plil 

PHI 

PHI 

PHI 

PHI 

PHI 


JU 

40 

50 

60 

70 

80 

90 


PHI  100 
PHI  110 
PHI  120 
PHI  130 
PHI  140 
PHI  150 


***  Z-BLOCK  IS  SAVED  ON  TAPE. 

PHI 

160 

common 

Z 

PHI 

170 

COMMON 

PK 

PHI 

180 

COMMON 

YY  .  XX 

PHI 

190 

COMMON 

DDX.  ddy 

PHI 

200 

common 

AMX.  AlX  *  U.  V  .  P 

PHI 

210 

COMMON 

TaU.  jpm 

PHI 

220 

COMMON 

UL  »  PL 

PHI 

230 

COMMON 

XP  .  Yp»  CMXP.  CMYP 

PHI 

240 

***  NON-D I MENS I ONED  VARIABLES 

PHI 

250 

COMMON 

aid  »ammv  »ammy  .ampy 

.AMUR 

.AMUT 

» AMVR  . 

PHI 

269 

1AMVT 

.DELEB  »DELER  .DELE7  '  DELM  rDTODX 

.DXYMIN.EAMMP 

.EAMPY  . 

PHI 

270 

2E 

# EKQUMP  » I  .13  » IWS  . J 

.K 

»KA 

»K8  t 

PHI 

280 

3LL 

.  MD  .ME  »MZT  . NERR  .NK 

» NPRINT 

. 

PHI 

290 

4NR 

»NRZ  » NULLE  .PIDTS  .SIEMIN’SNR 

.SNT 

.STR 

.SOLID  » 

PHI 

300 

5SUM 

.TESTRH'TWOPI  ,URR  »WS  .WSA 

» WSB 

.wsc 

. WFLA6F » 

PHI 

310 

6wFLAGL 

. WFLAGP 

PHI 

320 

PHI 

330 

***  THE  FOLLOWING  EQUIVALENCES  MAKE  AVAILABLE 

PHI 

340 

X(0).  Y  ( 0 )  »  DX ( 0 ) .  DY(0) 

PHI 

350 

PHI 

360 

EQUIVALENCE  (XX(2) »  X(l))p  ( YY(2) .  Y(l>) 

PHI 

370 

EQUIVALENCE  (DDX(2)>  DX(1))»  (DDY(2)i  DY ( 1) ) 

PHI 

380 

***  SPECIAL  EQUIVALENCES  FOR  EDIT 
EQUIVALENCE  (PR(1)»  IJ)  »  (PR(6) r  JK) 

***  Z-STORAGE  EQUIVALENCES 

EQUIVALENCE  (Z(  1>»PR0B  >r(Z(  2). CYCLE  )t 


PHI  390 
PHI  400 
PHI  410 
PHI  420 
PHI  430 
PHI  440 
PHI  450 
PHI  460 
PHI  470 
PHI  480 
PHI  490 
PHI  500 
PHI  510 
PHI  520 
PHI  530 
PHI  540 
PHI  550 
PHI  560 
PHI  570 
PHI  580 


oonoooonoon 


f5 

* 

.if  ' 


1<  ZC  3)*JT  ) 

»  (Z C 

4) 

. NUMSP 

)  . 

<Z< 

5)  . 

NFRCLP) . 

(Z  < 

6)  r 

NDUMP7) 

* 

PHI 

590 

2<Z<  7) » ICSTOP) 

*  <  2  ( 

8) 

*PIDY 

)  . 

(Z( 

9) 

.  TQPMU  ) 

.  (Z( 

10) 

.rtmu 

) , 

PHI 

600 

3(Z(  lD.STKi  ) 

»<Z( 

12) 

.NUMREZ) . 

(Z  c 

13) 

» ETH  ) 

» (Z( 

14) 

» UN14 

)  . 

PHI 

610 

4<Z<  15) .RHINIT) 

.<z< 

16) 

.PROJI 

) . 

( Z 

17) 

»UN17  ) 

.  CZ< 

18) 

»xmax 

) . 

PHI 

620 

5(Z(  19). NZ  ; 

»  <Z< 

20) 

.  NREZ 

) . 

<z< 

21) 

» amdm  ) 

.  (Z ( 

22) 

.UVMAX 

) . 

Phi 

630 

6(Z(  23).UN23  ) 

.(Z< 

24) 

»DMIN 

) . 

<z< 

25) 

.  JSTR  ) 

.  (Z( 

26) 

.dtna 

) . 

PHI 

640 

7(Z(  27) .CVIS  ) 

.(Z( 

28) 

»STK2 

)  . 

CZ( 

29) 

.STEZ  ) 

.  (Z ( 

30) 

»nc 

)  . 

PHI 

650 

6(Z(  31) .UN31  ) 

.  (z( 

32) 

>NRC 

). 

(Z< 

33  > 

» IMAX  ) 

.  (Z( 

34) 

» IMAXA 

) . 

PHI 

660 

9(Z(  35) . JMAX  ) 

•  Izl 

36) 

.  JMAXA 

). 

(Z( 

37) 

»KMAX  ) 

.  (ZC 

38) 

•kmaxa 

) 

PHI 

670 

equivalence 

PHI 

680 

1CZC  39).U0TM  ) 

*  (Z( 

40) 

.BOTMV 

)  . 

<Z< 

41) 

.NUMSPT) 

.  (Z( 

42) 

.CZERO 

)  . 

PHI 

690 

2 (Z (  43) .NUMSCA) 

.(Z( 

44) 

.PRLIM 

)  . 

<Z( 

45) 

.PRDELT) 

.  (Z( 

46) 

.PRFACT) 

PHI 

700 

EQUIVALENCE 

PHI 

710 

1(Z(  47). 11  ) 

.  <z< 

48) 

.12 

)  . 

(ZC 

49) 

» IPCYCL) 

.  (Z( 

50) 

.  TSTOP 

) . 

PHI 

720 

2 ( Z (  51) .RHOFIL) 

» <z< 

52) 

» TARGV 

) . 

( z 

53) 

»N3  ) 

.  ( z 

54) 

.IVARDY) . 

PHI 

730 

3<Z<  55). VT  > 

.(Z( 

56) 

»N6 

)  . 

(Z( 

57) 

»RTM  ) 

.  (Z( 

58) 

»rtmv 

). 

PHI 

740 

4(21  59) »UN59  ) 

.(Z( 

60) 

.  N10 

)  . 

<zc 

61) 

.Nil  ) 

.( Z( 

62) 

.GAMMA 

). 

PHI 

750 

5(Z(  63J.T0PM  ) 

.  (z< 

64) 

.botmu 

)  . 

(Z( 

65) 

»SN  ) 

.  (Z( 

66) 

.TOPMV 

). 

PHI 

760 

6(Z<  67) .PRY30T) 

.<z( 

68) 

.PRYTOP) » 

(ZC 

69) 

.PRXRT  ) 

.  (Z( 

70) 

.CYCPH3) . 

PHI 

770 

7(Z(  71) .REZFCT) 

»<Z( 

72) 

.TARGI 

). 

(2( 

73) 

.PROJU  ) 

.  (Z  ( 

74) 

.BBOUND) . 

PHI 

780 

8 (Z (  75) »EVAP  ) 

.(Z( 

76) 

.ECK 

)  . 

(Z( 

77) 

.necycl) 

.  (Z( 

78) 

»II 

)  » 

PHI 

790 

9(Z(  79) » JJ  ) 

» (Z( 

80) 

»NMP 

)  . 

<z< 

81) 

.  Y2  ) 

.  (Z( 

82) 

.EZPH1 

) 

PHI 

800 

EQUIVALENCE 

PHI 

810 

1(Z(  83) . IVARDX) 

.  (Z< 

84) 

.T 

)  . 

(Z( 

85) 

.NMPMAX) 

.  (ZC 

86) 

»pmin 

). 

PHI 

820 

2<Z(  87). INTER  ) 

#  cz  ( 

88) 

.TAYBOT) . 

(Z( 

89) 

.TAYTOP) 

.(Z( 

90) 

.iemap 

)  . 

PHI 

830 

3 (Z(  91). MC  ) 

.  (Z( 

92) 

.MR 

) . 

( Z  ( 

93) 

.MZ  ) 

.  (Z ( 

94) 

.MB 

) 

PHI 

840 

EQUIVALENCE 

PHI 

850 

1(ZC  95) .REZ  ) 

.(ZC 

96) 

.NODUMP) » 

(Z( 

97) 

.UN97  ) 

»(Z( 

98) 

.UN98 

)  . 

PHI 

860 

2<Z<  99)»UN99  ) 

. (ZCIOO) 

.EVAPM 

). 

(Z(101) 

.EVAPEN) 

» (Z( 102) 

.EVAPMU) » 

PHI 

870 

3(Z(103) .EVAPMV) 

. (z(104) 
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). 
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» I VMAP 

). 
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6(Z(115) .KHOZ  ) 
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.ESA 

). 

(Z ( 117) 
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.ESB 

). 

PHI 

910 
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»ESESP 

)» 

(Z(121) 

.ESESQ  ) 

. (Z ( 122) 

»ESES 

)  . 

PHI 

920 

8(Z(123) . ESALPH) 

. (Z(124) 

.ESBETA) » 
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.IUMAP 

). 
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9(Z(127).SS1  ) 

.  (ZH28) 

.  SS2 

)  . 

(Z(129) 

»UMIN  ) 

. (Z( 130) 

.SS4 

) 

PHI 

940 

EQUIVALENCE 

). 

PHI 

950 

1(Z(131)»PRTIME) 

. (Z(132) 

»EOR 

). 

(Z1133) 

.EOT  ) 

. (Z(134) 

»EOB 

PHI 
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2<Z(135).EM0R  ) 

. 1 Z (136) 

»DXF 

)  . 

(Z ( 137) 

»dyf  ) 

. (Z(138) 

.RHOMIN). 

PHI 

970 

3(Z(139) .STAS) . 

(Z(140) . 

XIENRG] 

. 

(Z(141) 

.XKENRG) 

.  ( Z ( 1 42 ) .XTENRG) 

» PHI 

980 

4<Z(143)»STT  ) 

» (Z(144) 

»DTMIN 

)  . 

(ZC145) 

.TRNSFC) 

» (Z(146) 

.emot 

). 

PHI 

990 

5(ZC147) .JPROJ  ) 

. CZC148) 

.cnaut 

)» 

(Z1149) 

.bbar  ) 

. (ZC150) 

.EMOB 

) 

PH11000 

PH11010 

PH11020 

PH11030 


PH11010 

. ' . . . •  »  «  •PH11020 

PH11030 

END  OF  COMMON  PHI 1040 

PH11050 

. PH11060 

*♦*  PHI  COMPUTES  THE  EFFECT  OF  THE  PRESSURE  GRADIENTS  ON  PHU062 

UPDATING  THE  VELOCITIES  AND  INTERNAL  ENERGIES.  PH11064 

PH11070 

***  NRT  AND  NRC  ARE  USED  TO  ADVANCE  THE  ACTIVE  GRID.  PH1I075 

NRT=0  PH11080 

NRC=0  PH11090 

C  ***  VEL=1.  FLAGS  FIRST  PASS.  ON  SECOND  PASS.  VEL  =  0.  PH11095 

VEL=I.O  PH11100 
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c 
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70 

C 

c 

c 
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***  KC  =  DISTANCE  FROM  AXIS  -TO  CENTER  OF  CELL  K. 

KK  =  DISTANCE  FROM  AXIS  TO  CENTER  OF  CELL  K+l. 
HC=DX(l)/2.0 
AR=RC+CDXU)+DX<2)  )/2.0 
K=2 

***  FOR  At_L  CELLS  IN  COLUMN  NEXT  TO  AXIS*  SET  PRESSURE 
AT  LEFT  SIDE  OF  CELL  =  PRESSURE  IN  CELL*  AND  SET 
RADIAL  VELOCITY  AT  LEFT  SIDE  OF  CELL  =  0. 
uO  cU  J-l * JMAX 
Pl(J)=P(K) 

UL(J)=0.0 
K=K+IMAX 
DO  140  1-1*11 
K=I  +  1 

***  OEFINE  PRESSURE  AND  AXIAL  VELOCITY  AT  BOTTOM 
BOUNDARY  OF  GRIO. 

VaLO=V(K) 

POLO=P(K) 

***  IF  BOTTOM  BOUNDARY  OF  GRID  IS  REFLECTIVE*  SET 
AXIAL  VELOCITY  AT  THAT  BOUNDARY  =  0. 

IF  (CVIS.GT. (-.5) )  VBL0=0. 

TAUDTS=TAU(I)*DT 
GO  130  J=1 *  12 
N=K+IMAX 

PIDTS=1.0/(PIOY*DT*DY( J) ) 

IF  tAMXCK) .LE.O. )  GO  TO  30 
IF  II.LT.IMAX)  GO  TO  SO 

***  FOR  ALL  CELLS  IN  LAST  COLUMN  OF  GRIO*  SET  PRESSURE 
AT  RIGHT  OF  CELL  =  PRESSURE  IN  CELL.  COMPUTE 

ENERGY  LOST  ACROSS  RIGHT  BOUNDARY  AND  SUBTRACT  IT 
FROM  £TH*  THEORETICAL  ENERGY  TOTAL. 

PHRrp ( K ) 

£=PRR*U(K)/P1DTS*X(I) 

£TH=ETH-E 
EOR=EOR-E 
GO  TO  40 

***  CELL  K  IS  EMPTY 
PL(J)=0. 

ULlJ)=UU+l)*RR 

PoLO=0. 

VBLO=V(N) 

GO  TO  13u 
URR=RC*U(K) 

GO  TO  70 

***  IF  CELL  ON  RIGHT  IS  EMPTY  SET  SPECIAL  P  AND  U 
IF  l AMX (K+l ) .GT . 0 . )  GO  TO  60 
PrtR=0. 

URR=U(K)*RC 
GO  TO  70 

PRR=(P(K)+PCK+1) )/2. 

URR=(U(K)+RC+U(K+l)*RR>/2. 

IF  IJ.LT.JMAX)  GO  TO  60 

***  FOR  ALL  CELLS  IN  TOP  ROW  OF  GRID*  SET  PRESSURE  AND 
AXIAL  VELOCITY  AT  TOP  OF  CELL  =  PRESSURE  AND  AXIAL 
VELOCITY  IN  CELL.  COMPUTE  ENERGY  LOST  ACROSS  TOP 
60UN0ARY. 

PABOV£=P(K> 


PHiiioa  '1 

PH11104 

PH11110 

PH11120 

PH11130  1 

PH11132  ? 

PH11134 

PH11136 

PHI 1140 

PH11150 

PHI 11 60 

PH11170 

PHlliBO 

PH11190 

PH11192 

PH11194 

PH11200 

PH1121G 

PH11212 

PH11214 

PH11220 

PH11230 

PH11240 

PH11250 

PH11260 

PH11270 

PH11280 

PH11282 

PH11284 

PH11286 

PH11288 

PH11290 

PH11300 

PH11310 

PH11320 

PH11330 

Phll335 

PH11340 

PH11350 

PH11360 

PH11370 

PH11380 

PH11390 

PH11400 

PH11410 

PH) 1420 

PH11430 

PH11440 

PH11450 

PH11460 

PH11470 

PH11480 

PH11482 

PH11484 

PH11486 

PH11486 

PH11490 


99 


E=PABOV£*V ( K ) /2»*TAUDTS 
ETH=ETH"E 
EOT=EOT-E 
V ASOVE— V ( K ) 

60  TO  110 

***  If-  ClLL  AbGvt  IS  EMPTY  SET  SPECIAL  P  AND  V 
IF  <AMX(N) .GT.Q.)  60  TO  90 
PABOV£=0. 

VA80V£=V(K) 

60  TO  100 

PABCVE=(P(K)+P(N) )/2. 

VABOVE=(V(K)+V(N) )/2, 

IF  (J.GTol)  60  TO  110 

***  IF  BOTTOM  BOUNDARY  OF  GRID  IS  REFLECTIVE*  ADD  TO  ETH 
THE  ENERGY  GENERATED  BY  PRESSURE  AT  THAT  BOUNDARY. 

IF  (CVIS.6T.-.5)  60  TO  110 
E=PBLO*V ( K) /2 . *TAUDTS 
ETH=£rH+£ 

F08=£0B+£ 

IF  (VEL.EQ.O.)  60  TO  120 

***  COMPUTE  UPDATED  VELOCITIES  ON  FIRST  PASS  (VEL  =  1.) 
V(K)=V(K)+(PBLO“PABOVE)*TAUDTS/(AMX(K) ) 
U(K)=U(K)+(PL(J)-PRR)/(AMX(K) ) *RC/PIDTS*2. 0 
CONTINUE 

***  AIX(X)  CHANGED  ON  BASIS  OF  GRADIENTS  COMPUTED  IN  FIRST 
PASS.  ON  SECOND  PASS  AIX(K)  CHANGED  AGAIN  ON  BASIS 
OF  GRADIENTS  CACULATED  FROM  THE  UPOATED  VELOCITIES. 

WS- ( VBL0-VA50VE) *T  AUDTS/2. 

WS=(UL( J)-URR)/PIDTS+WS 
WSA=A IX ( K ) +WS*P ( K ) / AMX ( K ) 

AIX(K)=!v$A 

V3LQ™VAB0VE 

PLiu)=PRR 

UL(U)=URR 

PBLO=FaBOVE 

***  RC *  Nr  RR  REDEFINED  FOR  NEXT  CELL  IN  ROW  J. 

K=N 

RC=RR 

RR=(X(I+l)+X(I+2) )/2„0 

IF  (VEL.EQ.O,)  GO  TO  150 

VEL=0.0 

GO  TO  10 

CO  190  1=1 r II 

K=I+1 

00  180  J=lrI2 

***  sn  =  0  (input  parameter)  sets  negative  internal 

ENERGIES  TO  EERO. 

IF  (AIX(K) .GE.0..OR.SN.GT.0.)  GO  TO  170 
E= A 1 X ( K ) * AMX ( K ) 

ETH=ETH-E 

EZPH1=EZPH1-E 

IF  (INTER. E3.0)  GO  TO  16C 

***  PRINT  PROPERTIES  OF  CELLS  WHOSE  NEGATIVE  ENERGY  IS 
SET  TO  ZERO  WHEN  DOING  INTERMEDIATE  PRINTS  (INTER. GT.O) 
WRITE  (6*240)  I*J»AMX(K) »AIX(K) *U(K) *V(K) 

AIX(K)=0.0 

IF  (I.NE.I1)  GO  TO  180 
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PH11710 
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PH11760 
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***  ENLARGE  ACTIVE  GRID  IN  I-DIRECTION  IF  A  CELL  IN  THE  II  PH11952 


COLUMN  HAS  NONZERO  VELOCITY  OR  ENERGY.  PH11954 

IF  (UCK).N£.G..OR.V(K).NE.Q..OR.AIX(K).NE.O.)  NRC=1  PH11960 

K-K+IMAX  PH11970 

LL=K-2*IMAX  PH1198Q 

***  ENLARGE  ACTIVE  GRID  IN  J-DIRECT10N  IF  A  CELL  IN  THE  12  PHU982 

ROW  HAS  NONZERO  VELOCITY  OR  ENERGY.  PH11984 

IF  {U(LL).NE.O..OR.V(LL).NE.O..OR.AIX(LL).NE.O.)  NRT=1  PH11990 

CONTINUE  PH12000 

I1-I1+NP.C  PH12010 

I2=I2+NRT  PH12020 

***  DONT  ALLOW  ACTIVE  GRID  TO  EXCEED  IMAX  BY  JMAX  GRID.  PH12025 

IF  (Il-IMAX)  210 t 210 t 200  PK12030 

11= IMAX  PH12040 

IF  ( I 2- JMAX)  230 #230. 220  PH12050 

12= JMAX  PH12060 

RETURN  PH12070 

PH12080 

FORMAT  (4H  PHI »2I4*4H  M-,1P£15.8,6H  SIE=» 1PE15.8»4H  U=»1PE-.5.8»PH12090 

14H  V=»1PE15.8»13H  SIE  SET  TO  ZERO)  PH1210Q 

END  PH12110- 
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SUBROUTINE  PH3 


DIMENSION  AMX12502) »AIX(2502) fU(2502>  »V(2502)  »P(2502)  » 

X(S2)  #XX(54)  »TAU(52)  »JPM(52)  » 

Y ( 102)  #  YY ( 104)  » FLEFT ( 102) t  YAMC(102),  SIGC(102)» 

GAMC ( 102) » 

PK ( 15) #  Z(l50)  # 

XP(26#51) »YP(26,5l) # 

PL(204)  »UL(204)  »PR(204)  » 

RSN(52)»  RST ( 52) » 

CMXP(5)  ?CMYP(5)  »IJ(5)  >JK(5)  » 

DX(52)  »l)DX(54)  »DY(102)  »DDY(104)  t 

SNBC52)  fSTB(52)  *UK(52»3)  »VK(52»3>  »RH0(52»3) 

***  DIMENSIONED  ARRAYS 


#P (2502) 


» JK (5)  » 

»DDY (104)  » 

»VK(52»3)  »RH0(52»3) 


PH3  30 
PH2  40 


PH3  70 
PH3  80 
PH3  90 
PH3  100 
PH3  110 
PH3  120 
PH3  130 
PH3  140 
PH3  150 


***  Z-BLOCK  IS 
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ON  TAPE. 
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U» 
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PH3 
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TAU» 

JPM 

PH3 

220 

COMMON 

UL  » 

PL 

PH3 
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COMMON 

XP  t 

YP» 

CMXP  t  CMYP 

PH3 
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***  NON-DIMENSIONED 

variables 
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COMMON 

AID  r 

AMMV 

»  ammy  rAMPY  »AMUR  »amut  »amvr  » 

PH3 

260 
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2E 

3LL 

4N°. 
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»DELEB  »DELER  »D£LET  »DELM  »DTODa  »DXYMIN»EAMMP  »EAMPY 


t ERDUMP » I 
» MD  » ME 
» NRZ  »NOl.LE 
rTESTRH»TWOPI 


1 13 
»MZT 


#IWS 

#NERR 


rPIDTS  #SIEMIN«SNR 


f'JRR 


t  WSA 


t  K  rKA 

»NPRINT» 
,SNT  #STR 
rWSB  #WSC 


»SOLlD  » 
tWFLAGFr 


6WFLAGL»WFLAGP 


***  THE  FOLLOWING  EQUIVALENCES  MAKE  AVAILABLE 
X(Q)»  Y(0) »  DX(0)»  DY(0) 

EQUIVALENCE  (XX(2) »  X(l))»  (YY (2) r  Y(l) ) 

EQUIVALENCE  (DDX(2)»  DX(-))»  (DDY(2)»  DY(1) ) 

***  SPECIAL  EQUIVALENCES  FOR  PH2  ONLY 


EQUIVALENCE 


(UL»FLEFT)» 
(PL»GAMC»PR) » 


(UL(10.3)  » YAMC)  r 
(PL(103) »SIGC) 


***  SPECIAL  EQUIVALENCES  FOR  PH3  ONLY 


EQUIVALENCE 


(UL»RSN) » 
(PL»RST) t 
(P(157) » VK) » 
(P(365) »STB) » 


(PrUK) » 
(P(313)»SNB) t 
(P (417) • RHO) 


***  SPECIAL  EQUIVALENCES  FOR  EDIT 
EQUIVALENCE  (PR(1)»  IJ) »  (PR(o)»  JK) 


***  Z-ST0RA6E  EQUIVALENCES 


(Z(  DrPROB  )ti  Z(  2)rCYCLE 


PH3  270 
PH3  280 
PH3  290 
PH3  300 
PH3  310 
PH3  320 
PH3  330 
PH3  340 
PH3  350 
PH.3  360 
PH3  370 
PH3  380 
PH3  390 
PH3  400 
PH3  410 
PM3  420 
PH3  430 
PH3  440 
PH3  450 
PH3  460 
PH3  470 
PH3  480 
PH3  490 
PH3  500 
PH3  510 
PH3  520 
PH3  530 
PH3  540 
PH3  560 
PH3  560 
PH3  570 
>»  PH3  580 
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) 

(ZC116) 

»ESA 

) . 

{ Z (117) 

. ESEZ  ) 

. (Z(118) 

»ESB 

)  r 

PH3 

910 

7CZ1119) .ESCAPA) 

» (z(k0) 

.E3ESP 

) » 

( Z ( 121 > 

.ESESQ  ) 

» (Z(122) 

.ESES 

)  . 

PH3 

920 

o(Z(l<;3)  » C.SALPH) 

» (ZC1Z4) 

.ESBETA) » 

(Z ( 123) 

.ESCAPB) 

» (Z ( 126) 

.IUMAP 

)  . 

PH3 

930 

9(Z(127) .SSI 

) 

» CZC1Z8) 

» SS2 

) . 

(ZC129) 

»umin  ) 

r (ZC130) 

.SS4 

) 

PH3 

940 

EQUIVALENCE 

PH3 

950 

1(2(131)  .PRT1ME) 

»  dd52) 

»c.QR 

) . 

(Z(133) 

.EOT  ) 

. CZ(134) 

.EOB 

)  r 

PH3 

960 

2CZU33)  . EMOR 

) 

. (ZC136) 

»DXF 

) . 

(Z(137) 

» DYF  ) 

.  (Z(138) 

.RHOMIN) t 

PH3 

970 

3(Z(139) .STAB) » 

(Z(l40) . 

XIENRG) 

. 

( Z ( 141 ) 

.XKENRG) 

»  (Z(142) .XTENRG) 

.PH3 

980 

4(Z(143) .STT 

) 

. C  Z  C 144) 

.DTMIN 

) . 

(Z(145) 

. TRNSFC) 

. (Z ( 146) 

»EMOT 

)  . 

Ph3 

990 

5(Z(147) » UPROJ 

) 

» t Z C 148) 

.cnaut 

) . 

(ZC149) 

»B8AR  ) 

. (Z(150) 

»EMOB 

) 

PH31000 

PH31010 

. . . ..... . ......... PH31Q20 

PH31030 

ENU  OF  TOMMON  PH31040 

PH31050 

•  . . ••••••• . . . . . . . . . PH31Q60 

DX(0)=-DX(1>  PH31070 

DY (G)--QY (1)  PH31080 

PH31090 

***  TURN  ON  R-P  TREATMENT  WHEN  ACTIVE-GRID  REACHES  JSTR  PH31100 

IF  (I2.LT.JSTR)  60  To  400  PH31110 

***  TURN  OFF  JSVR  PH3112C 

USTk=0  PH31130 

Prt=0.  PH31140 

***  USE  P-STORAGE  FOR  U.V.SIE  BEING  CALC.  PH3115Q 
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DO  10  K-2#KMAX 
P(K)=0. 

***  calculate  subcycle  dt 

ICP3  =  INT(CYCPHo) 

***  calculate  factor  for  variable  dt 

N=ICP3*(ICP3+1> 

DTFACT=2. /FLOAT (N) 

***  LOOP  THRU  SUBCYCLES 
DO  380  NN=1»1CP3 

***  DECREASING  DT 
WS=1CP3**NN+1 
DTSTR=WS*DTFACT*DT 

***  INITIALIZE  UK#VK  FOR  R0W1#2  AND  BORDER  BELOW 
***  NOTE  THAT  THESE  ARE  STORED  WITH  AN  EXTRA  CELL  TO 
RIGHT  AND  LEFT  OF  MESH.  SO  K  =  2  IS  AXIS  CELL. 


VFACT=-1. 

***  IF  REFLECTIVE# PUT  NEG.  V  IN  BORDER  CELLS 
IF  (CVIS.LT.O.)  VFACT=1. 

***  BUT  IF  TRANS.#  USE  V 

NKB=i 

NK=2 

NKA=3 

***  SET  LIMITS  USED  IN  PH3 

MX I 1+1 
LL=I1-1 
no  20  K=2#M 
L=K+IMAX 
I=K-1 

***  SET  VALUES  ADJOINING  BOTTOM  ROW 
RHO(K»NK)=AMX(K)/(TAU(I)*DYCD) 

RHO ( K » NKd ) =RHO  ( K » NK ) 

RH0(K»NKA)=AMX(L)/(TAU(I)*DY(2)) 

UK(R»NK)=U(K) 

UK(K#NKB)=U(K> 

UK(K»NKA)=U(L> 

VK(K»NK)=V(K) 

VK(K»NKB)=V(K)*VFACT 

VKvX»NKA)=VCL) 

***  BORDER  CELL  TO  LEFT 
DO  30  N=l»3 
RH0(1»N)=RH0(2»N) 

UK(1»N)=UK(2#N) 

VK(1»N)=VK(2»N> 

***  SNB  AND  STB  HAVE  BEEN  SET  TO  0.  BY  SETTING  ALL 
P  STORAGE  TO  0.- 

***  SET  NORMAL  STRESSES  ON  BOTTOM  IF  REFLECTIVE 
IF  (CVIS.LT.O.)  GO  TO  100 
IF  ( IMAX.GT . 1 )  GO  TO  40 
***IMAX=1 

WSA=1.-AIX(2)/STEZ 
IF  (WSA.LT.01  WSA=0. 

WSb=AMX ( 2 ) / ( TAU ( 1 ) *DY ( 1 ) *RHOZ ) -1 . 

STR£NG= ( CZERO+WSa* ( STK1+WSB*STK2 ) ) *WSA 
IF  (STRENG.LT.O.)  STRENG=0. 

SNB ( 2 ) =STRENG*SQRT (2) *ABS ( V ( 2 ) > /V ( 2 ) 


PH31160 

PH31170 

PH31180 

PH31190 

PH31200 

PH31210 

PH31220 

PH31230 

PH31240 

PH31250 

PH3I260 

PH31270 

Ph31230 

Ph31290 

PH31300 

PH31310 

PH31320 

PH31330 

PH31340 

PH31350 

Ph31360 

PH31370 

PH31380 

PH31390 

PH31400 

PH31410 

PH31420 

PH31430 

PH31440 

PH31450 

PH31460 

PH31470 

PH31480 

PH31490 

PH31500 

PH31510 

PH31520 

PH31530 

PH31540 

PH31550 

PH31560 

PH31570 

PH31580 

PH31590 

PH31600 

PH31610 

PH31620 

PH31630 

PH31540 

PH31650 

PH31660 

PH31670 

PH31680 

PH31690 

PH31700 

PH31710 

PH31720 


so  TO  100 

rv.  ■  —  «  -n  A 

rnoi t ou 

c 

PH31740 

c 

***PUT  Irtb  =  RIGHT  BOUNDARY  OF  JrM  ARRAY 

r\i  .  -»  4  -»  rz  n 
'HUl  / 

40 

IWS=1 

PH31760 

DO  bO  I=i»IMAX 

PH3177G 

IF  (JPM(l) .£0.0)  GO  TO  60 

PH31780 

IwS=i.vS+l 

PH31790 

50 

CONTINUE 

PH31800 

C 

PH31810 

60 

DO  90  K=2»IWS 

PH31820 

v.SA= .  b*DX  ( K )  +DX  ( iv  1  H.b*DX  ( K-2 ) 

PH31830 

UU0UX=(U(K+1)-U(K-1) )/WSA 

PH31840 

DV0DX=(V(K+1)-V(K-1) >/WSA 

Ph31850 

0VODY=2*V(K)/DY(1) 

PH31860 

U0X=2*U(K)/(X(K-l)+XlK-2)  ) 

PH31870 

WSA=DU0DX+DV0DY+U0X 

PH31880 

TH03=WSA/3. 

PH31890 

WS=UU0DX**2+DV0DY**2+U0X**2+.5*(DV0DX**2)-TH03*WSA 

PH31900 

IF  (WS.LE.O.)  GO  TO  70 

PH31910 

WSA=1.-AIX(K)/STEZ 

PH31920 

IF  (WSA.LT.O.)  WSA=0. 

PH31930 

WSB= AMX ( K ) / ( TAU ( K-l ) *DY (1) *RHOZ) -1 . 

PH31940 

STR£nG=(CZERG+WS6*(STK1+WSB*STK2) )*WSA 

PH31950 

IF  (STRENG.LT.O.)  STR£N6=Q. 

PH31960 

b=STR£NG*SQRT ( 2 . / WS ) 

P)  -1970 

GO  TO  60 

PH31980 

70 

6=0. 

PH31990 

80 

SnB(K)=8*(0V0DY“Th03) 

Ph32000 

90 

CONTINUE 

PH32010 

100 

L=I2-1 

PH3202Q 

C 

***  DO  ROWS 

PH32030 

DO  370  U=1 » L 

PH32040 

K=(J-l)*lMAX+2 

PH32050 

C 

***  STRESS  AT  AXIS  =0. 

PH32060 

S[\|L=0 . 

PH32070 

STL=0 . 

PH32080 

C 

***  LOOP  ON  CELLS  ACROSS  ROW 

PH32090 

DO  330  1=1 »LL 

PH3210G 

IK=I+1 

PH32110 

C 

***  IF  NOT  SOLID*  SKIP  STRESS  CALCULATION 

PH32120 

IF  (RHO(IK»NK) .LT. SOLID)  GO  TO  170 

PH32130 

C 

***  IF  ABOVE  vIPMUJ+l  WE  ARE  DONE  WITH  THIS  ROW 

UNLESS  ALSOPH32140 

C 

BELOW  JPM(I-I) 

PH32150 

UFLAG=0 

PH32160 

IF  ( J.LE. JPM(I)+i)  GO  TO  110 

PH32170 

IF  ( I oEQ.l)  GO  TO  340 

PH32180 

IF  (U.GT. JPM(I-l) )  GO  TO  340 

PH32190 

UFLAG=1 

PH32200 

C 

***  CALCULATE  strength 

PH32210 

uo 

wSA=l .-AIX (K) /STEZ 

PH32220 

IF  (WSA.LT.O.)  GO  TO  170 

PH32230 

WSB=RHO ( IK » NK ) /RriOZ-1 . 

PH32240 

STRENG= (CZER0+WS6* ( STK1+WSB*STK2 ) ) *WSA 

PH32250 

IF  (STRENG.LT.Q.)  GO  TO  170 

PH32260 

c 

PH32270 

c 

c 

***  HOOP  STRESS*** 

PH32290 

HOOP=G. 

IF  (J.EQ.JPM(I)+l.CR.JFLAG.EQ.l)  GO  TO  170 
***  SKIP  HOOP  AND  RT  CALC  IF  1-D 
IF  (IMAX.EQ.l)  GO  TO  140 

***  DIFFERENCES  ARE  CENTERED  AT  CELL-CENTER 
U0X=UK(IK*NK)/(X(I)+::U-1)  )*2. 
WS=1./(.S*DX(I+1)+DX(I)+.5*DX(I-1)) 

DU0DX=  ( UK < IK+1 * NK ) -UK (IK-1  » NK >  ) *vi S 
DVODX= ( VK ( IK+1 * NK ) -VK ( IK-1  *  NK ) ) * WS 
wS=i./(»S*DY(J+l)+DY(J)+.5*DY(U-l) ) 

DUODY=  ( UK ( IK  *  NKA ) -UK ( IK » NK3 ) )  *WS 
DV0DY=(VK(IK*NKA)-VK(IK»NK3>)*WS 
ASSIGN  120  TO  LOCA 
GO  TO  240 

***  CALCULATED  TH03#B 
HOOP=B*(UOX-TH03) 


..<>...***  END  OF  HOOP  CALC. 


PH32300 

PH32310 

PH32320 

PH32330 

PH32340 

PH32350 

PH32360 

PH32370 

PH32380 

PH3239C 

PH32400 

PH32410 

PH32420 

PH32430 

PH32440 

PH32450 

PH32460 

PH32470 

PH32480 


. . . . . ..PH32490 

***  IF  THE  CELL  ON  RIGHT  IS  NOT  SOLID*  STRESSES  ARE  ZERO  PH32500 


IF  (RHO(IK+l»NK) .LT.SOLID.OR.IK.EQ.LD  GO  TO  14C  PH32510 

***  DIFFERENCES  ARE  CENTERED  AT  RIGHT  EDGE  OF  CELL  PH32520 

*S=2./(DX(I)+DX(I+1) )  PH32530 

DU00X=(UK(IK+1*NK)-UK(IK*NK) )*WS  PH32540 

DV0DX=(VK(IK+1»NK)-VK(IK*NK) )*WS  PH32550 

GS=i . / ( D Y ( J+l ) +2 . *DY ( J ) +DY ( J-l ) )  PH3256Q 

DUOQY- ( UK ( IK  *  NKA ) +UK ( IK+1 » NKA ) -UK ( IK  *  NKB ) -UK  C IK+1 *  NKB ) ) *WS  PH32570 

DVODY- ( VK ( IK » NKA ) + VK ( IK+1 *  NKA) -VK ( IK*  NKB  > -VK ( IK+1 » NKB ) ) *WS  PH32580 

U0X=(UK(IK+1,NK)+UK(IK»NK) )/X(I>*.5  PH32590 

PH32600 

ASSIGN  130  TO  LOCA.  Ph32610 

***  CALC.  TH03  AND  B  PH32620 

GO  TO  240  PH32630 

SNR=B*(DU0DX-TH03)  PH32640 

STR=B*(DU0QY+DV00X>*.5  PH32650 

GO  TO  150  PH32660 

SNR=0.  PH32670 


STR=0. 


***  IF  The  cell  above  is  not  solid*  STRESSES  above 


Tr-  /p*.ia  i  v*  ...i/*  \  i  t  C/M  T  r\  a  n  «  Ta  1  OA 

*r  \rvnv\ JLf\*IMr\n/ »LT .sOLIw. vn.U.CW.U*  »  v/  iou 


***  DIFFERENCES  ARE  CENTERED  AT  TOP  EDGE  OF  CELL 
WS=2./(DY{J+1)+DY(U) ) 

DUODY=(UK(IK»NKA)-UK(IK*NK) ) *WS 
DVODY= ( VK ( IK » NKA ) -VK ( IK » NK  > ) *W S 
WS=1./(DX(I+1)+2.*DX(I)+DX(I-1) ) 

DUODX= ( UK ( IK+1 *  NK ) +UK  C IK+1 » NKA ) -UK ( IK-1  *  NK ) “UK  C IK-1 » NKA ) ) *WS 
DVODX= ( VK { IK+1 » NK ) +VK ( IK+1 *  NKA) -VK ( IK“1 *  NK) -VK (IK-1  *  NKA ) ) *WS 
U0X=(UK(IK»NKA)+UK(IK*NK))/(X(I)+X(I-1>) 

ASSIGN  160  TO  LOCA 
GO  TO  240 

SNT=B*(0V0DY-TH03) 

STT=3*(0U0DY+DV0DX)*.5 

GO  TO  190 

SNR=0. 

STR=0 . 


PH32680 
AREPH32690 
PH3270Q 
KH3271Q 
PH32720 
PH32730 
PH32740 
Ph3275Q 
PH32760 
PH32770 
PH32780 
2790 
.  H32800 
PH32810 
PH32820 
PH32830 
PH32840 
PH32850 
PH32860 


180 


19C 


C 

C 

200 


210 

C 

C 

c 


220 


SnT=0.  _  PH32870 

STT-u.  PH32880 

IF  (AMX(K) oGT.U. )  GO  TO  190  PH32890 

•0  TO  230  PH32900 

F  UNTER.NE.9C)  GO  TO  200  PH32910 

VR I T£  (6.410)  I . J » IK . NKB . NK . NKA » HOOP » SNL . STL » SNR . STR » STRENG . SNB ( iKPi .32920 
1) .STB(IK) .SNT.STT  PH32930 

***  ALL  STRESSES  ON  CELL  K  HAVE  BEEN  CALCULATED.  NOW  TPH32940 
***  NE.»  VALUES  of  U.V.  and  S.I.E.  CAN  BE  DETERMINED.  PH32950 
SNLX=SNL*X(I~1)  PH32960 

>vS=TWGPI*DTSTR/A.-1X£K)  PH32970 

IF  tlMAXoEQol)  60  TO  210  PH32980 


QELU=ivS*£DY(u)*(SnR*X(I)~SNLX)+TAU£I)/TWOPI*£STT-STB(IK)  ) -HOOP*DX (PH3299Q 


II ) *QY ( J) )  PH33000 

STLX=STL*X(I-1)  PH33010 

DELV=WS* £ ( SNT-SNo ( IK) ) *TAU £ I ) /TWOPI+DY ( J ) * ( STR*X ( I ) -STLX ) )  PH33020 

PH33030 

***  NOW  CALC.  CHANGE  OF  ENERGY  PH33040 

***  UKT  AND  VKT  ARE  TEMPORARY  STORAGE  PH33050 

UKT=UK(IK. NX)  PH33060 

VKT=VK(IK»NK)  PH33070 


WS=TAUC1)*05*( £  (UKT+UKUK.NKA)  )*STT+£VKT+VK£lK»NKA)  )+SNT)-£  (UKT+UKPH33080 
1  ( IK?  NKB) ) *STB ( IK) + ( VkT+VK ( IK. NKB) ) *SN3 £  IK) ) )  PH33090 

WSA=PIDY*DY £j)*£X£I)*££UK£ IK+1 » NK ) +UKT ) *SNR+  £ VK  C IK+1 ► NK) +VKT) *STR) PH33100 


1- ( X ( 1-1 ) * ( ( UKT+UK ( IK-1  *  NK) ) *SNL+ (VKT+VK ( IK-1 » NK) > *STL) ) )  PH33110 

WS3= £  WSA+WS) /AMX £  K ) *OTSTR  PH33120 

WSC=OtLU* £  UKT+DELU/2 . ) +DELV* £  VKT+DELV/2. )  PH33130 

DELI=WS3-WSC  PH33140 

IF  £  INTER. NE. 99)  GO  TO  220  PH33150 

WRITE  (6.420)  I > U . IK . DELU . DELV » DELI  PH33160 

U(K)=U(K)+DELU  PH33170 

V(K)=V£K)+DELV  PH33180 

AIX£K)=AIX£K)+DELI  PH33190 


C 

230 


C 

C 

C 

240 


260 

260 

C 

270 

C 

c 


bB0uND=3d0UND+DELI*AMX£K) 

***  CELL  K  IS  DONE.  MOVE  TOP  TO  BOTTOM  AND  RIGHT  TO  LEFT 
SNB£IK)=SNT 
STB ( IK) =STT 
SNL=S(MR 
STL=STR 
GO  TO  280 


***  CALCULATE  TH03  AND  B 

V.'SA=DUODX+DVODY+UOX 

THQ3=«SA/3. 

WS=DU0DX**2+DV0DY**2+U0X**2+,5*(DU0DY+DV0DX)**2~TH03*WSA 
IF  (WS.LE.O.)  GO  TO  250 
b=STREN6*SQRT ( 2 . /WS ) 

60  TO  260 

8=0  a 

IF  ( INTER. NE. 99)  GO  TO  270 

WRITE  £6.430)  DU00X.DV0DY.U0X»TH03»DU0DY.DV0DX.WS»B»L0CA 
GO  TO  LOCA.  £130.160.120) 


PH33200 

PH33210 

PH33220 

PH33230 

PH33240 

PH33250 

PH33260 

PH33270 

PH33280 

PH33290 

PH33300 

PH33310 

PH33320 

PH33330 

PH33340 

PH3335Q 

PH33360 

PH33370 

PH33380 

PH33390 

PH33400 

PH33410 

PH3342Q 


c 

c 

260 


290 


300 


310 

320 


330 

C 

C 

*  340 


350 

C 


C 

360 

C 

370 

C 

360 

390 


END  OF  THUS  AND  S  CALCULATION 


IF  ( INTER. NE. 99)  GO  TO  330 
E=0. 

DO  290  LJD=2#KMAX 

E=E+AMX(LJD)*(.5*<U(LJD>**2+V<LJD)**2)+AIX<LJD> > 

CONTINUE 

WRITE  (6#440>  I>J,E 
DO  300  LJD=2#1K 

U8AR= . 5* ( UK ( L JD » NK ) +UK ( L JD » NKA ) > 

VBAR= . 5* ( VK l L JD  »NK)+VK( L JD  *  NKA ) > 

E=E-TAU ( L JD-1 ) * ( JBAR*STB ( L JD ) +VBAR*SNB { L JD  >  >  *OTSTR 
IKK=IK+1 

DO  310  LJD=IKK»I1 
IF  (J.GT.wPM(LJD-2) )  GO  TO  320 
UBA R= .  5*  f.  UK  <  L  JO  * NK )  +UK  ( L  JD  t  NKB ) ) 
VBAR=.5*(VK(LJD»NK)+VK(LJD»NKB) ) 

E=E-TAU l L JD-1 ) * ( UBAR*ST8 ( L JD ) +VBAR*SNB ( L JD  > ) *DTSTR 
UBAR=.5*(UK(IK+lrNK)+UK(IK»NK5 ) 

VBAR=.5*(VK(IK+lfNK}+VK(lK»NK>  > 

E=E-TW0P1*DY ( J) *X(I ) *(UBAR*SNL+VBAR*STL>  *DTSTR 

WRITE  (6»  440 )  I»J»E 

PW=PW+DELI*AMX(K) 

WRITE  (6»450)  PW 
K=K+1 

***  end  of  loop  on  i 

***  MOVE  NK-POINTERS  AND  STORE  A  NEW  ROW  OF  VELOCITIES 
IF  (J.EQ.L)  GO  TO  370 
NKA=NKA+1 
NKSNK+l 
NKB=NKB+1 

IF  (NKAcGTe3)  NKA=i 
IF  (NK.GTo3)  NK-1 
IF  (NKB.GT.3)  NK3=1 
K=(J+l)*IMAX+2 
DO  350  1=1 t II 
IK=I+1 

UK(IK»NKA)=U(K) 

VK ( I K » NKA ) = V { K ) 

RHO(IK#NKA)=AMX(K)/(TAU(I)*DY(J+l) )  . 

K=K+1 

***  End  loop 

IF  ( IMAX#NE*1)  GO  TO  360 
UK(3»NKA)=UK(2»NKA> 

VK(3»NKA)=VK(2»NKA) 

RHO ( 3 » NKA ) =RHO ( 2  r  NKA ) 

UK(1»NKA)=UK(2»NKA> 

VK(l»NKA)=VKl2»NKA> 

RH0(1»NKA)=RH0(2»NKA) 

***  END  OF  J-LOOP 

CONTINUE 

***  end  of  rigid-plastic  calculation  for  one  dtstr 

continue 

DO  390  K=2#KMAX 
P(K)=0. 


PH33430 

■  -»  ■»  l.  /I  A 

rrwj'rtu 

PH33450 

PH33460 

PH33470 

PH33480 

PH33490 

PH33500 

PH33510 

PH33520 

PH33530 

PH33540 

PH33550 

PH33560 

PH33570 

PH33580 

PH33590 

PH33600 

PH33610 

PH3362Q 

PH33630 

PH33640 

PH33650 

PH33660 

PH33670 

PH33680 

PH33690 

PH33700 

PH33710 

PH33720 

PH33730 

PH33740 

PH33750 

PH33760 

PH33770 

PH33780 

PH33790 

PH33800 

PH3381Q 

PH33820 

PH33830 

PH33840 

PH33850 

PH33860 

PH33870 

PH33880 

PH33890 

PH33900 

PH33910 

PH33920 

PH33930 

PH33940 

PH33950 

PH3396Q 

PH33970 

PH33980 

PH33990 


108 


voo 

c 

4lO 


>20 


400 


4oG 


RETURN 


.,'•.34000 
PH34010 

FO....AT  (/6I5>/7H  H00?=» 1PZ12.&»7h  SNL  =>lPEi2.6»7H  STL  =*1PE12.PH34020 

lo  ?  7H  SNR  =/iP£12.6»7H  SIR  => lPEl2.6»/7riSTRcNG=» 1PE12.6»7H  SNB  =PH34030 
2/ lPEl2<>o> 7H  STB  =*iPEi2.6>7H  SMT  =>1?E12.6»7H  STT  ->1PE12o6/)  PH34040 

FUR,*, AT  (/3IS,/7rt  0ELU=/1PE12.6>  7h  DELV=»  1PE12.6# 7H  DELI=»  J.PE12.PH34050 

16/)  PH34060 

FCA,*.«T  (7.-,  uuQDX-t  1PE12 .o ? 7P.  3V0DY=>  1.  Z12. 6» 7H  UOX  =»1PE12.6>7H  TPH34070 
1.-03  =»lPil2.o»/7n  0UuDY=»lPEl2.o»7H  DVODX=»  1PE12.6»7H  WS  =»  1PE12PH34080 


r  vA, 

w,\D 


'ri 
•.A  i 
•i  AT 


b  - ; 1PE12 • 6 t 1 7 ) 

(4X>2riI  =  l2,4X>2HJ=l2>4Xf2rl£=:.P£l3.7) 
(hX»3HPW=1PE12*6) 


PH34090 

PH34100 

PH34110 

PH34120- 


109 


*1' 


Cl  IU  Dim  it*  t  \»r 

WVWIWV  I  1KU 


m  i  ^ 

r  nc. 


c 

c 


c 

c 

c 


c 

c 

c 

I#** 

V 

c 

c 


DIMENSION  AMX (2502) #AIX(2502) »U(25C2) 


1 

2 

3 

4 

5 

6 
7 
6 
9 


X(52>  #XX<54)  #TAU(52> 

Y ( 102)  # YY (104) 

6AMCU02)  » 

?K ( 15)  #  2(150)  # 
XP(26#5l) # YP(2b»5li # 

PL(2Q4)  #UL(204)  >PR(204) 

RSN(52)#  RST (52)  # 

CMXP (5)  #CMYP (5)  > 1 J ( 5) 

DX (52)  #0DX(54)  #DYtlQ2) 

SNB (52)  # STB (52)  #UK(52#3> 

***  DIMENSIONED  ARRAYS 
***  2-BLOCK  IS  SAVED  ON  TAPE. 


r V (2502) 
► JPM(52) 


»P (2502) 


# FLEFT (102) #  YAMC ( 102) .  S1GCU02)# 


» JK (5) 

#DDY(1Q4) 

#VK(52»3) 


#RH0(52»3) 


EQUIVALENCE 


(UL»FLEFT) » 
(PL»GAMC»PR) # 


(UL ( 103) >YAMC) # 
(PL(103) »SIGC) 


***  SPECIAL  EQUIVALENCES  FOR  PH3  ONLY 


EQUIVALENCE 


1 

2 

3 


(UL»RSN) # 
(PLrRST ) # 
(P(157) #VK) # 
(P(365) »STB) » 


(P# UK) , 
(P(313) #SN8) » 
(P(417) rRHO) 


***  SPECIAL  EQUIVALENCES  FOR  EDIT 
EQUIVALENCE  (PR(1)#  IJ)  #  (PR(o)#  JK) 

***  2-STORAGE  EQUIVALENCES 

EQUIVALENCE  ( 2  C  l)#PROB  )»(Z(  2)#CYCLE 


r  net 
.  PH2 
Pr12 
PH2 
PH2 
PH2 
PH2 
PH2 
PH2 
Ph2 
PH2 
PH2 
PH2 
Pri2 
PH  2 
PH2 


20 
30 
40 
50 
6  U 
70 
80 
90 
100 
110 
120 
130 
140 
150 
160 


COMMON 

2 

PH2 

170 

COMMON 

PK 

PH2 

180 

Common 

YY  # 

XX 

PH2 

190 

COMMON 

DDX# 

ddy 

PH2 

200 

COMMON 

AMX » 

AIX#  U» 

V#  P 

PH2 

210 

COMMON 

TAUf 

J?M 

PH2 

220 

COMMON 

UL  # 

PL 

PH2 

230 

COMMON 

XP  # 

Yp»  CMXP#  CMYp 

Pn2 

240 

c 

#**  NON-D I MENS I ONED 

variables 

PH2 

250 

COMMON 

AID  » AM MV 

#  AMMY  #  AMPY 

» AMUR  » AMUT 

» amvr  # 

PH2 

260 

1AMVT 

#D£LEB 

#  QElER  / DELET 

»delm  #dtodx 

#DXYMIN#EAMMP 

#eam°y  # 

PH2 

270 

2E 

i  ERDUMP # I  #13 

»IWS  *J 

?  K  #KA 

»KB  » 

PH2 

280 

3LL 

» MO 

#ME  #M2T 

»nerr  #nk 

» NPRINT  # 

PH2 

290 

4NR 

» NRZ 

#NU’.LE  #piots 

»siemin#snr 

» SNT  #str 

#solid  # 

Pri2 

300 

5SUM 

#T£STRH#TwJPl  »URR 

» ws  » WSA 

»WSB  #WSC 

#  WFLAGF ' 

Ph2 

310 

6WFLAGL#WFLAGP 

PH2 

320 

c 

PH2 

330 

c 

***  THE  FOLLOWING  EQUIVALENCES  MAKE  AVAILABLE 

PH2 

340 

c 

X(0)»  Y ( 0 ) #  DX(0) #  DY ( 0 ) 

PH2 

350 

c 

PH2 

360 

EQUIVALENCE 

(XX(2) #  X(l))# 

( YY (2) #  Y(l) ) 

PH2 

370 

EQUIVALENCE 

(DQX(2)»  DX(D) 

»  (DCY (2) #  DY ( 1) ) 

PH2 

380 

c 

> 

PH2 

390 

c 

***  SPECIAL  EQUIVALENCES  FOR  PH2 

only 

PH2 

400 

PH2 
PH2 
PH2 
PH2 
PH2 
PH2 
PH2 
PH2 
PH2 
PH2 
PH2 
PH2 
PH2 
PH2 
PH2 
PH2 
PH2 
)»  PH2 


410 

420 

430 

440 

450 

460 

470 

480 

490 

500 

510 

520 

530 

540 

550 

560 

570 

580 


110 


c 

c 

c 

c 

c 

c 

r 

C 

C 


c 


HZC  3 )  p  OT 

) 

p  (Z( 

4) 

/ NUMSP 

)  f 

(Z< 

5)  p 

NFRELP) p 

■  Z( 

6)  p 

NDUMP7) 

p 

PH2 

^90 

2(Z(  7) t ICSTQP) 

?  (Z( 

a)  triO'i 

)  * 

p  i  ; 

l  c.  \ 

a  \ 

V  t 

— */\  a  ,4i  i  \ 

i  I  vr>iu  t 

-  /  "7  / 
f  \  t-  \ 

1  A  \ 
X  1/  * 

-  dTui  l 

r  i \  •  nv 

}  . 

Pm  o 

600 

3  ( Z  (  iUfSTRi 

) 

»(2( 

12) >  numrez 

)  t 

( 2  ( 

13) 

pETH  ) 

7  (2  ( 

14) 

pUN14 

)  p 

PH2 

610 

4(Z(  Id) # KnlNlT) 

p  cz( 

16) 

p PROJI 

)  » 

( 2  ( 

17) 

p  UN17  ) 

P  (2( 

18) 

pXMAX 

)  p 

PH2 

620 

5 ( Z (  19) t NZ 

) 

»(2( 

20) 

•  NRE2 

)  p 

(2( 

21) 

r  AMD.M  ) 

p  (Z( 

22) 

pUVMAX 

)p 

PH2 

630 

o(Z(  25) t UN23 

) 

»(2( 

24) 

fDMlN 

)  » 

( 2  ( 

25) 

pJSTR  ) 

p  (Z( 

26) 

pDTNA 

)  p 

PH2 

640 

7  ( 2  (  27) p  CVIS 

) 

» ( 2  ( 

28) 

p  STK2 

)  p 

C  2  ( 

29) 

pSTEZ  ) 

P  (Z( 

30) 

pNC 

)  p 

PH2 

650 

6  ( 2  (  31 ) f UNol 

) 

p (2( 

32) 

> NRC 

)  p 

( 2  ( 

33) 

pIMAX  ) 

9  ( l 

34) 

pIMAX  A 

)  p 

PH2 

660 

9 ( 2 (  r UMAX 

) 

p  (2( 

36) 

p jmaxa 

)  p 

( 2  ( 

37) 

pKMAX  ) 

P  (Z( 

38) 

pXMAXA 

) 

PH2 

670 

EQUIVALENCE 

PH2 

680 

1 ( 2 (  39) i 60TM 

) 

p  ( 2  ( 

40) 

pBotmv 

)  » 

( 2  ( 

41) 

pNUMSPT) 

P  ( 2  ( 

42) 

rCZERO 

)  p 

PH2 

690 

2CZC  93) ; NUMSCA) 

*  (z( 

44) 

f  PRLiM 

)  p 

( 2  ( 

45 ) 

pPRDELT) 

P  (Z( 

46) 

pPRFACT) 

PH2 

700 

EQUIVALENCE 

PH2 

710 

I  (Z(  47)  »a 

\ 

/ 

;  (Z( 

48) 

p  12 

)  p 

( 2  ( 

49) 

PIPCVCL) 

P  (2 ( 

50) 

pTSTOP 

}  9 

PH2 

720 

2(2 (  51)  pRKOFl 

L) 

;  (2( 

52) 

mARGV 

)  7 

(Z( 

53) 

PN3  ) 

p  (Z( 

54) 

pIVARDY) p 

Pri2 

730 

3 ( 2 (  55 ) > VT 

) 

*  (Z( 

56) 

•  No 

)  P 

( 2  ( 

50  p 

pRTM  ) 

p  (Z( 

58) 

p  rtmv 

)  7 

PH2 

740 

4 ( 2 (  59) p  Un59 

) 

»  (z( 

bO) p NiO 

)  * 

(2( 

61) 

PN11  ) 

p  (Z( 

62) 

P  gamma 

)  7 

PHI 

750 

5(2(  63) ; TOPM 

) 

p  (2( 

64 ) 

; BQTMU 

)  p 

( 2  ( 

65 ) 

pSN  ) 

p  (7( 

66) 

pTOPMV 

)  7 

PH2 

760 

6(2(  67) ;PRYdOT) 

p  (Z( 

63) 

pPRYTOP) p 

(Z( 

69) 

pPRXRT  ) 

p  (2( 

70) 

-CYCPH3) p 

PH2 

770 

7 ( 2 (  71) f REZFCT) 

» (Z( 

72) 

*targi 

)  p 

( 2  ( 

73) 

pPRCJU  ) 

p  (Z( 

74) 

PBBOUND) p 

PH2 

780 

8(2(  75) >EVAP 

) 

p  (z( 

76) 

?  ECK 

)  p 

( 2  ( 

77) 

pNECYCL) 

?  (2 ( 

73) 

pII 

)  P 

Pi"i2 

790 

9(Z(  79) « JJ 

) 

V  (2( 

60) 

;  NMP 

)  p 

(Z( 

61) 

pY2  ) 

p(Z( 

82) 

pEZPHI 

) 

PH2 

800 

EQUIVALENCE 

PH2 

810 

1 ( 2(  63) ; IVARDX) 

»  ( 2  ( 

b4 ) 

» T 

) 

(2( 

85) 

p  KM PM AX) 

r  (2( 

66) 

p  PM  IN 

)  P 

PH2 

820 

2(21  67; » INTER 

) 

p  (Z( 

v.F) 

pTAYBOT 

)  7 

( 2  ( 

69) 

pTAYTOP) 

p  (2( 

90 

pICMAP 

)  P 

PH2 

83C 

3 (2(  91)»MC 

) 

p  (7' 

92; 

;  MR 

)  7 

(Z( 

93) 

pM2  ) 

p  (Z( 

94; 

p  MB 

) 

PH2 

840 

EQUIVALENCE 

PH2 

850 

HZ(  95 )  >  RE2 

) 

p  ( Z  ( 

96) 

t NODUMP) p 

(Z( 

97) 

pUN97  ) 

p  (2( 

96) 

7  UN98 

)  P 

PH2 

860 

2(Z(  99) t UN99 

) 

» (2(100) pEVAPM 

)  7 

(ZdOi) 

pEVAPEN) 

p (Z(102) 

pEVAPMU) 7 

PH2 

870 

6(2(103) pEVAPMV) 

p (2(104) 

> EZPH2 

)  P 

(Z( 

105) 

p  SNL  ) 

p (Z(106) 

pSTL 

)  P 

PH2 

880 

9(Z( 107) >TAXRT 

) 

f (2(108) 

t IDNMAP) p 

(2(109) 

pIPRMAP) 

p  (Z( 

110) 

pROEPS 

)  P 

PH2 

890 

5(2(111) »RHINI 

) 

p (Z( 112) p  VINI 

)  7 

(Z(113) 

pFINAL  ) 

p (2(114) 

pIVMAP 

)  P 

PH2 

900 

6(2(115) ) RH02 

) 

p ( Z ( 116) 

pESA 

)  , 

(Z( 

117) 

;ESEZ  ) 

p(Z(118) 

pESB 

)  P 

PH2 

910 

7(2(119) , ESCAPA) 

» (Z(120) 

p ESESP 

)  P 

(2(121) 

pESESQ  ) 

p (2(122) 

pESES 

)  P 

PH2 

920 

6(2(123) pESALPH) 

p (Z(124) 

pESBETA 

)  7 

(2(125) 

pESCAPB) 

p (Z(126> 

pIUMAP 

)  r 

PH2 

930 

9 (2(127) pSSI 

) 

p (2(128) 

p  SS2 

)  P 

(Z(129) 

pUMIN  ) 

7  (2(130) 

pSS4 

) 

PH2 

940 

EQUIVALENCE 

PH2 

950 

1(2(131) > PRTIM 

E) 

r (2(132) 

;EOR 

)  P 

(Z ( 133) 

pEOT  ) 

p  (Z( 

134) 

pE03 

)  p 

PH2 

960 

2(2(135) pEMOR 

) 

9  (Z( 

15  '  ' 

;DXF 

)  P 

(2(137) 

pDYF  ) 

P (Z ( 138) 

pRHOMIN) p 

PH  2 

970 

3(Z(139) pSTAB) 

» 

(2(140 

XIENRG ) 

P 

(Z(141) 

pXKENRG) 

p  (Z 

(142) pXTENRG) 

p  PH2 

980 

4(2(143) >  STT 

) 

p  i  2  ( 

144) rDTMIN 

)  P 

(Z ( 145) 

pTRNSFC) 

p (Z(146) 

pEMOT 

)  p 

PH2 

990 

5(2(147) ? JPROJ 

) 

’ (2(148) pCnAUT 

)  7 

(2(149) 

pBBAR  ) 

p (Z(15Q) 

pEMOS 

) 

PH21000 

PH21010 

***  SPECIAL  EQUIVALENCE  FOR  PH2  PH21012 

EQUIVALENCE  (WSOUTpUOTK)  PH21014 


end  of  common 


SUN'S- 0  o 

***  are  tracer  points  being  generated 

IF  (Y2.GT. (”!.)>  GO  TO  260 

**#  YES,  CALCULATE  NEW  POSITIONS  OF  POINTS  IN  ACTIVE  GRID. 
DO  250  J=I;JJ 


PH21020 

PH21030 

PH21040 

PH21050 

PH21060 

Ph21070 

PH2109G 

PH21095 

PH21100 

PH21105 

PH21I1Q 


UO  250  1=1>II 

IF  iXP(i.»U)  .LL.O.)  GO  TO  250 
IX=XP(I#J) 

IY=YP(1> J) 

i r  ( IX. GT .11)  GO  TO  250 
IF  (IY.GT.I2)  GO  TO  250 
K=IY*lMAX+IX+2 

C  ***  SKIP  CALCULATION  IF  POINT  IS  IN  EMPTY  CELL 

C  (AHEAD  OF  THE  MASS  IT  REPRESENTS) . 

IF  IAMXCK) .EU.G.)  GO  TO  250 

C  ***  FkX  AND  FRY  GIVE  LOCATION  OF  TRACER  POINT  IN 

C  CELL( IX+1 » IY+1) • 

FRX=XP(I# J)-AINTCXP(1»J) ) 

FRY=Y?(I* J)-AInTCYP(1» J) ) 

C 

C  ***  IaS=1  FLAGS  TRACER  POINTS  IN  CELLS  ON  RIGHT  OR 

C  LEFT  BOUNDARY  OF  GRID. 

C  I.vS=2  FLAGS  TRACER  POINTS  IN  CELLS  ON  TOP  OR 

C  BOTTOM  BOUNDARY  OF  GRID. 

C  IwS=0  FLAGS  TRACER  POINTS  IN  CELLS  WHICH  ARE  NOT 

C  ON  A  GRID  BOUNDARY. 

:..s=u 

C  ***  SEE  if  TRACER  POINT  IS  IN  A  BOUNDARY  CELL. 

:r  CX.LT.I)  GO  To  130 

iix.gt.:max-2)  go  to  no 
IF  (IY.lT.1)  GO  To  160 
IF  IIY.G. . JMAX-2)  GO  TO  140 

C  NOT  IN  BOUNDARY  CELL.  IS  POINT  ON  LEFT  SIDE  OF  CELL 

lu  IF  CFRX.LT • .5)  GO  TO  40 

C  POINT  IS  ON  RIGHT  SIDE  OF  CELL.  IS  CELL  ON  RIGHT  EMPTY 

20  IF  ( AMX ( K+l )  . EQ . 0 • )  GO  TO  30 

;  RADIAu  COMPONENT  BASED  ON  AVERAGE  OF  RADIAL  VELOCITIES 

C  OF  CEuL  K  AND  CELL  ON  RIGHT  OR  LEFT. 

UEFF=(FRX-.5)*U(K+l)+(1.5-FRX)*UlK> 

GO  .TO  50 

C  ***  CELL  ON  RIGHT  OR  LEFT  EMPTY-USE  RADIAL  COMPONENT 

C  OF  CELL  K. 

3u  UEFr— U(K) 

GO  TO  50 

C  ***  POINT  is  ON  LEFT  SIDE  OF  CELL.  IS  CELL  ON  LEFT  EMPTY 

4U  IF  (AttXU-l)  .EQ.O. )  GO  TO  30 

C  RADIAl.  COMPONENT  BASED  ON  AVERAGE  OF  TWO  CELLS. 

UEFF=( .5-rRX)*U(K-l)+( ,5+FRX)*U(K) 

C  *+*  WHEN  ItfS  =  2  AXIAL  COMPONENT  OF  CELL  HAS  ALREADY  BEEN 

C  CALCULATED. 

50  IF  CIWS.GT.l)  GO  TO  100 

C  IS  POINT  IN  BOTTOM  HALF  OF  CELL 

bo  IF  (FRY  i_T •  . 5 )  GO  TO  90 

C  *♦*  POINT  IS  IN  TOP  HALF.  IS  CElL  ABOVE  EMPTY 

70  KA=K+IMAX 

IF  (AMXIKA)  ..10.0.)  GO  TO  SO 

C  *♦*  AXIAL  COMPONENT  BASED  ON  AVERAGE  OF  AXIAL  VELOCITIES 

C  OF  CELL  K  AND  CELL  ABOVE  OR  BELOW, 

VEFF=  C  FRY- . 5 ) * V ( KA )  +  ( 1 . 5-FR Y ) *V ( K ) 

GO  TO  100 

C  ***  CELL  ABOVE  OR  BELOW  IS  EMPTY.  USE  AXIAL  COMPONENT  OF 

C  CELL  K. 


PH21120 

PH21130 

PH21140 

PH21150 

PH21160 

PH21170 

PHBliaO 

PH21190 

PH21195 

Ph21200 

PH21202 

PH21204 

PH21210 

Ph21220 

Pii21230 

Pn21230 

?n21232 

PH21234 

PH21236 

PH21240 

PH21245 

PH21250 

PH21255 

PH21260 

PH21270 

Ph212S0 

PH21290 

PH21295 

PH21300 

PH21305 

PH21310 

Ph21312 

Ph21314 

Ph21320 

PH21330 

PH21342 

PH21344 

Prt21340 

PH21350 

PH21355 

PH21360 

PH21365 

PH21370 

PH21372 

PH21374 

PH21330 

PH21385 

PH21390 

PH21395 

PH21400 

PH21410 

PH21412 

PH21414 

Ph21420 

PH21430 

PH21432 

PH21434 


W  0 

v  nr V  ( (S  ) 

PH21440 

uu  TO  100 

PH21450 

V  v 

KA-i\~IMAX 

PH21460 

IF  ( AMX(K.A)  oLG.O. }  GO  TO  80 

PH21470 

V£FF=(.b--RY)*V(KA>-K.5-i-FRY)*V(K) 

PH21480 

***  IX+1  IS  1—INDc.X  AND  IY-f-i  IS  J— INDEX  OF  CELL  TRACER 

PH21482 

POINT  IS  IN.  COMPUTE  NEW  LOCATION  OF  TRACER  POINT. 

PH21484 

iOu 

DTODX=DT/UX(  iX-f-1) 

PH21490 

X?  ( I  >  o )  =XP  (I».J)  -J-U£FF*070DX 

PH21500 

oTOJY=DT/OY(lY-rl) 

PH21510 

YP ( 1 1 J) =YP ( I » J)  +  7EF  F -DTOOY 

PH21520 

r 

***IWS»LT • i  MEANS  TRACER  POINT  WAS  NOT  IN  BOUNDARY  CELL 

PH21522 

C 

BEFORE  BEING  MOVED »  AND  ITS  NEW  POSITION  NEED  NOT 

PH21524 

C 

BE  CHECKED  -  GO  TC  END  OF  LOOP. 

PH21526 

IF  ( IWS.LT.I)  GO  TO  250 

PH21530 

GO  • 0  200 

PH21540 

r 

#■*#  POINT  IN  CELL  ON  RIGHT  BOUNDARY. 

PH21542 

Uu 

~r  (FRX.l. T..b)  Gv  TO  *T0 

PH21550 

US=1 

PH21560 

UEFF=U(x) 

PH21570 

ij 

IS  POiNT  IN  CELL  ON  30TTCM  BOUNDARY 

PH21575 

12u 

-r  (IYoLT.1)  GO  TO  170 

PH21580 

***  is  point  in  cell  ON  TOP  boundary 

PH21585 

IF  (IY.GT.JMAX-2)  GO  TO  190 

PH21590 

GO  TO  60 

PH2160G 

c 

***  point  in  cell  ON  AXIS.  • 

PH216U5 

lou 

IF  (FRX.GT .  .b)  G.>  TO  20 

PH21610 

1;:S=1 

PH21620 

UEFF— 2o*FRX*U(K) 

PH21630 

GO  TO  120 

PH21640 

C 

***  POINT  IN  CELL  ON  TOP  BOUNDARY. 

PH21645 

Inu 

IF  (FRY.lT.,5)  GO  TO  10 

PH21650 

I  „’S=2 

Ph21660 

ioQ 

V£F F=V(K) 

PH21670 

GO  TO  10 

PH21680 

r 

W 

***  POINT  IN  CELL  ON  BOTTOM  BOUNDARY.  RADIAL  COMPONENT 

PH21682 

C 

HAS  NOT  BEEN  COMPUTED. 

PH21684 

ioU 

IF  iFRY.GT.o5)  GO  TO  10 

PH21690 

IwS-2 

PH21700 

Ir  ( CV I S . L i *  0 . )  GO  TO  15J 

PH21710 

V£FF=2.*FRY*-V(K) 

PH21720 

60  TQ  10 

PH21730 

C 

***  POINT  IN  CELL  ON  BOTTOM  BOUNDARY.  ;IAL  COMPONENT 

PH21732 

C 

HAS  BEEN  COMPUTED. 

PH21734 

170 

IF  (.* RY «G7  .  .5)  G*j  To  70 

DH21740 

C 

***  COMPUTE  AXIAL  COMPONENT  ON  BASIS  OF  BOTTOM  BOUNDARY 

PH21742 

C 

coinDI  r  i  on. 

PH21744 

IF  CCVIS.L'.  .0. )  GO  TO  130 

PH21750 

C 

•kv*  RErLECTIVE. 

PH21755 

V£FF=2.*FRY*V IK) 

Ph21760 

oO  TO  IOU 

PH21770 

C 

TRANSMITT 1 VE • 

PH21775 

Ic-u 

VEFF-V (K) 

PH21780 

GO  TO  100 

PH21790 

C 

***  POINT  IN  CELL  ON  TOP  BOUNDARY. 

PH21795 

190 

IF  (FRY «lT..u)  60  TO  90 

PH21800 

GO  TO  180 

PH21810 

A 


If  * 


C 

c 

•c 

c 

c 

200 

C 

C 

210 

220 

C 

C 

C 

250 

C 

C 


240 

C 

250 

C 

C 

260 


C 


270 

2o0 


290 

300 


310 

C 

C 

C 


3x5 

520 

350 

340 


***  SPECImL  TtSTS  FOR_TRACER  POINTS  WHICH  WERE  IN 
boundary  <„ells  before  bEIno  moved. 

***  IF  POINT  MOVED  BELO.'J  crid»  test  on  bottom  boundary 
CONDITION/  IF  REFLECTIVE  MOVE  POINT  BACK  INTO  GRID/ 
IF  TRAN-SMITTIVE  SET  X-COORDINATE  TO  -1. 

IF  { YP ( I » J) »LT.  0  ♦ )  GO  TO  220 

***  IF  point  crossed  top  boundary  set  its  x-coordinate 

TO  -1. 

IF  ( I NT ( YP ( I / J) ) »LT • JMAX)  GO  TO  230 
XP(IrJ)=-l. 

GO  TO  250 

IF  (CVIS.LT.Q.)  GO  TO  210 
***  REFLECTIVE. 

YPlI/ J)=-YPCI»J) 

***  ADJUST  X-COORDINATE  IF  ITS  CALCULATED  POSITION  IS 

negat ive. 

IF  (XP(I»J) .LT.O. )  GO  TO  240 

***  IF  POINT  CROSSED  RIGHT  30UNDARY  SET  ITS  X-COORDlNATE 
TO  -1. 

IF  (INT(XP(I/J) ) .LT.IMAX)  GO  TO  250 

GO  TO  210 

XPCI/J)=-XP(I»J) 

***  END  OF  LOOP  FOR  TRACER  POINT  MOVEMENT. 

CONTINUE 


PH21812 

Prt2I814 

Pm21616 

PH21818 

Pn2l8l9 

PH21820 

PH21822 

PH21824 

PH21630 

PH21B40 

PH21850 

PN21860 

PH21865 

PH21870 

Pn218?2 

PH21874 

PH21860 

PH21882 

Ph.21884 

PH21890 

PH21900 

PH21910 

PH21915 

PH21S20 


***  SET  TO  ZERO  ACTIVE  GRID  AND  REZONE  FLAGS. 

NRT=0 

NRC=0 

REZ=0.0 

PIDTS=lcO/(PIDY*DT) 

TrtOPOT=2./PIDTS 

K=2 

CALCULATE  FLUXES  ON  LEFT  SIDE  OF  CELLS  IN  AXIS  COLUMN. 
do  3io  j=i»jn;;.x 
IF  (AMXIK; .LE.O.)  GO  TO  270 
IF  (U(K)  »,„T.O. )  GO  TO  280 
Fl.EFT  ( J)  lq  o 
GO  TO  300 

GAMC(J)=AMX(K)*U(K)*OT/DX(l) 

IF  {(GAMC(Ji4AMX(KP.GE.Q.)  GO  TO  230 
G AMD ( J ) =-AMX ( K ) 

FLEFT ( J ) =2 . *GAMC ( J) *U(K) /SS2 
SAMC(J)=0« 

YAMC ( J) ~0. 

SIGC ( J) ~U  o 
K-K+ I MAX 

***  DO  LOOP  IN  I “DIRECTION  -  MOVE  UP  COLUMNS  -  SPECIAL 

TREATMENT  FOR  FLUXES  AT  BOTTOM  BOUNDARY  OCCURS  BEFORE 
J-LOOP  3EGINS. 

DO  1150  1=1-11 

J=1 

K=I+1 

I F C «MX i K ) )  1220/  330/  320 
IF  (-V (K) .GT.UMlN)  GO  TO  340 
AMMV=0 . 0 
GO  TO  390 

AMMY=AMX (K) *V(K) *DT/DY{ J) 


PH21925 

PH21930 

PH21940 

PH21950 

PH21960 

PH21970 

PH21980 

PH219S5 

PH21990 

PH22Q00 

PH22010 

PH22020 

PH22030 

PH22040 

PH22050 

PH22060 

PH22070 

PH22080 

PH22090 

PK22100 

PH22110 

PH22112 

PH22H4 

PH22116 

PH22120 

PH22130 

PH2214G 

Ph22150 

PH22160 

PH22170 

PH22180 

PH22190 


x-Lh 


3i>0 

3o0 

C 

C 

370 


C 

C 

3d0 


390 


C 

400 


C 

C 

C 

c 

c 

c 

c 

c 

c 


c 

410 


C 

42Q 

C 

430 

C 

440 


IF  (AMMY+AMXOO  )  350 #360 #360 
AMMY=“AMX(K) 

IF  (CVIS)  370  * 380 * 380 

***  BOTTOM  BOUNDARY  IS  TRANSMITTI VE*  MATERIAL  IS  MOVING 
OUT *  REMOVE  ITS  ENERGY  FROM  ETH. 

mv:..j=a,v.my*u(k) 

A V=aMMY#V  (K) 

*>ILEu=AIXCK)  +  (U(K)**2+V(K}**2)/2.0 

j-;_ej=ammy*oeleb 

-■■'.Ols— C.M03—QELE& 

E7ri=ETH+OELEB 
607M=d0T  M-AMMY 
dOTMV-BOTMV-AMMV 
d  O  7  M  U = B  O  7  M  U  -  A  M  M  U 
GO  TO  400 

***  bottom  boundary  is  reflective*  net  momentum  change 

IN  2  DIRECTION  is  2*MV/SS2. 

IF  (V(K) «6£.0. )  GO  TO  330 
A,v.MV=2  .  *AMMY*V  ( K )  /SS2 
AMMY=0 , 0 
AMMU=0 . 

DELEd=0.0 

***  BEGIN  DO  LOOP  IN  J(Z)  DIRECTION. 

DO  1140  J=1»I2 


PH22200 

PH22210 

PH22220 

PH22230 

PH22240 

PH22250 

PH22260 

PH22270 

PH2228G 

PH22290 

PH22300 

PH22310 

PH22320 

PH22330 

PH22340 

PH22350 

PH22360 

PH22370 

PH22360 

PH22390 

PH22400 

PH22410 

PH22420 

PH22430 


MSLAVE=0  PH22440 

NSi.AVE=0  PH22450 

IP  (J.EQ.UMAX)  GO  TO  420  PH22460 

NOT  At  TOP  OF  MESH  PH22470 

L  IS  INDEX  OF  CELL  ABOVE  K  PH224S0 

L=K+IMAX  PH22490 

IS  CELL  K  EMPTY  PH22500 

IF  (AMX(K) .GT.O.)  GO  TO  540  PH22510 

IF  CELL  ABOVE  IS  ALSO  EMPTY  THEN  FLUX=0  OR  PH22520 

IF  FLUX  WOULD  BE  OUT  OF  EMPTY  CELL*  THEN  FLUX=0.  PH22530 

IF  CAMX(L) •EQ.O**OR*V(L) . GE.O. )  GO  TO  430  PH22540 

CELL  ABOVE  NOT  EMPTY.  MASS  MOVING  IN  DIRECTION  OF  PH22550 
CELL  K  WHICH  IS  EMPTY.  PH22560 

IS  CELL  ABOVE  COLD  AND  SOLID  PH2257C 

IF  (AIX(L) .GT«ESESQ.OR.AMX(L)/(TAU(I)*DY (J+l) ) .GE.RHOZ)  GO  TO  410  PH22580 
COLD,  BUT  NOT  UP  TO  NORMAL  DENSITY  PH22590 

IS  NEXT  CELL  ABOVE  C  OLD  ~  °H22600 

IF  ( (J+l) .EQ.JMAX)  GO  TO  410  PH22610 

LA=L+IMAX  PH22620 

IF  IAIX(LA) .LT.ESESQ. AND. AMX(LA)/(TAU(I)*DY(J+1) ) .GT. SOLID)  GO  TO  PH22630 
1430  PH22640 

CELL  ABOVE  IS  HOT.  DO  NOT  HOLD  BACK.  PH22650 

M=L  PH22660 

V  EOVE=V(L>  PH22670 

ft'L.F=DY(J+l)  PH22680 

GO  TO  460  PH22690 

TOP  OF  MESH.  IS  MASS  MOVING  OUT.  PH22700 

IF  ( V  (K) .GT.O.)  GO  TO  440  PH22710 

SET  FLUX  TERMS  TO  ZERO.  PH22720 

AMPY=0.  PH22730 

GO  TO  590  PH22740 

MASS  MOVING  OUT  OF  TOP  BOUNDARY  PH22750 

VABOVE=V(K)  PH22760 
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iJ  » 


►-a 


WDYF=DY(U)  PH22770 

450  M=K  PH22780 

C  CALCULATE  MASS  FLUX  AT  TOP  OF  CELL  PH22790 

4o0  IF  (ABS(VASOVE) .LE.UMIN)  GO  TO  430  PH22800 

UVMAX=TRNSFC*DY(J)/OT  PH22810 

IF  (ASS(VABOVE) .LT.UVMAX)  GO  TO  480  PH22820 

IF  (VABOVE.GT.Q.)  GO  TO  470  PH2283Q 

VA80VE=-UVMAX  PH22840 

GO  TO  480  PH22850 

470  VABOVE=UVMAX  PH22860 

.  4to0  AMPY=AMX(M)*VA80VE*DT/WDYF  PH22870 

IF  (MSLAVE.NE.O)  GO  TO  500  PH22830 

490  EAMPY=,5*(U(M)*‘*2+V(M/**2)+AIX(Mi  PH22890 

UAMPY=U(M)  PH22900 

VAMPV=V(M)  PH22910 

GO  TO  590  PH2R920 

500  IF  (VABOVE.GT.Q.)  GO  TO  510  PH22930 

M=L  PK22940 

GO  TO  490  PH22950 

510  M=K  PH22960 

GO  TO  490  PH22970 

520  WSA=.5*(V(K)+V(L) )  PH22980 

WSB=1.0+(V(L)-V(K) )*DT/( (OYCJ+l)+OY(J) >/2*0>  PH22990 

ftOYF=CDY{ J)+DY{J+1) )/2.  PH23000 

VABOV£=WSA/WSB  PH23010 

IF  (MSLAVE.NE.O)  GO  TO  460  PH23020 

IF  (VABOVE)  530»43Q»450  PH23Q30 

550  M=L  PH23040 

GO  TO  460  PH23050 

.C  CELL  K  IS  NOT  EMPTY.  HOW  ABOUT  CELL  ABOVE  K.  PH23060 

540  IF  (AMX(L) .GT.O.)  GO  TO  550  PH23070 

C  CELL  ABOVE  IS  EMPTY.  IS  FLUX  INTO  IT.  PH23080 

IF  (V(K).LEoO.)  GO  TO  430  PK23090 

C  FLUX  TOWARD  EMPTY  CELL  PH23100 

IF  (J.EQ.l)  GO  TO  440  PH23110 

C  SHOULD  MASS  Bb  HELD  UP  UNTIL  CELL  IS  FULL  PH23120 

L3=K-IMAX  PH23130 

IF  (AIX(LB) .GT.ESESQ.OR.AIX(K) .GT.ESESQ.OR.AMX(LB)/(TAU(I)*DY(U-1)PH23140 
1) ,LT. SOLID. OR. AMX(K)/(TAU(I)*DY( J) ) .GT. SOLID)  GO  TO  440  PH23150 

GO  TO  430  PH23160 

550  IF  (V(K) .GT.O. .AND. V(L) .LT.O.)  GO  TO  560  PH23170 

IF  ( (J+l) .EQ.JMAX)  GO  TO  580  PH23IS0 

LA-L+IMAX  PH23190 

IF  (AMX(LA).GT.O..OR.V(K).Gc.O..OR.V(L/.GE.O.)  GO  TO  570  PH23200 

:  K  AND  L  NOT  EMPTY  3UT  CELL  ABOVE  L  IS  EMPTY  PH23210 

C  TEST  FOR  SLAVING  L  TO  K  PH23220 

IF  ( AMX ( L) / (TAU ( I ) *DY (J+l) ) .GE.RHOZ.OR. AIX(K) .GT.ESESQ.OR.AIX (L) .GPH23230 
1T.ESESQ)  GO  TO  520  PH23240 

C  YESf  SLAVE  L  TO  K  PH23250 

MSLAVE=L  PH23260 

MSK  PH23270 

GO  TO  520  PH23280 

C  ***  SSREFLECTIVESS  TREATMENT  PH2329Q 

560  VMK=V  ( K )  *  AM)'  ( K )  PH23300 

VML=V (L) ♦AMX (L)  PH23310 

WSA=VMK+VML  PH23320 

AMPY=«SA*OT/((DY(U)+OY(J+1))/2.0)  PH23330 


1x6 


so 


VAMPY=(VMK*V(K)+VML*V(L> )/WSA  PH23340 

UAMP Y= ( VMK*U { K ) +^ML*U ( L> ) /WSA  PH23350 

SAVt:K=AIX<K)  +  .5*<U(K)**2+V(/<>**2)  PH23360 

LAKPY=(V..1K+SAV£K+VML*(AIX(LJ+.5*CU(L)**2+V(L)**2>  ))/WSA  PH23370 

60  TO  590  PH23380 

IF  (J.EQ.i)  GO  TO  520  PH23390 

LB=K-IMAX  PH23400 

IF  ( AMX (LB).NE.O..OR.V(L).LE.O..OR.V(K).LE.O.)  GO  TO  520  PH23410 

SHOULD  K  BE  SLAVED  TO  L  PH23420 

IF  (AMX(K)/(TAU(I)*DY( J) > .GE.RHOZ.OR.AIX(L> .GE.ESESQ.OR.AIX(K) .GT.PH23430 
1ESES0)  GO  TO  520  PH23440 

YES.  SLAVE  K  TO  L.  PH23450 

.'•;SLaV£=K  PH23460 

PM?Tu.7n 

GO  TO  520  PH23480 

♦  ♦♦  CHECK  FOR  ONE-D  PH23490 

IF  ( aoSIAMPY) .LT.RO£PS*AMX(K) .AND.ABS(AMPY) .LT.ROEPS*AMX ( K+IMAX) )  PH23500 
1AXPY=0.  PH23510 

IF  ( IMAX.EQ. 1 )  GO  TO  620  PH23520 

IF  (I.EQ.IMAX)  GO  TO  610  PH23530 

NOT  AT  RIGHT  BOUNDARY  PH23540 

IS  CELL  K. EMPTY  PH23550 


IF  (AMX(K).GT.O.)  GO  TO  730  PH23560 

SET  FLUX=0  IF  CELL  ON  RIGHT  IS  EMPTY  PH23570 

OR  IF  VELOCITY  IS  AWAY  FROM  EMPTY  CELL  K  PH23580 

IF  tAMX(K+l) .£Q.O..OR.U(K+1) .GE.O.)  GO  TO  620  PH23590 

CELL  TO  RIGHT  IS  NOT  EMPTY.  SHALL  WE  LET  MASS  MOVE  PH23600 

INTO  CELL  K  WHICH  IS  EMPTY.  PH23610 

IF  (AIXCK+1).GT.ESESU.0R.AMX(K+1>/(TAU(I+1)*DY(J}).GT.RH0Z)  GO  TO  PH23620 


1600 

COLO  ANO  NOT  UP  TO  NORMAL  DENSITY 
IS  NEXT  CELL  TO  RIGHT  COLD 
IF  (d+D.EQ.IMAX)  GO  TO  600 


PH23630 

PH23640 

PH23650 

PH23660 


IF  (AIXU+2>.LT.ESESQ.AND.AMX<K+2)/<TAU<I+2>*DY<J>>.GT.S0Ll0>  GO  TPH23670 


10  626 

♦♦♦CELL  ON  RIGHT  IS  HOT.  DO  NOT  HOLD  BACK 

K=K+1 
URR=U(M) 

N=I+1 
GO  TO  650 

RIGHT  EDGE  OF  MESH 
IF  (U(K).GT.O.)  GO  TO  630 

NO  MASS  COMES  IN  FROM  OUTSIDE 
SET  FLUX  TERMS  TO  ZERO 


AXMP=0 . 

GO  TO  790 

MASS  MOVING  OUT  OF  RIGHT  EDGE 

URK=U(K) 

N=I 

K=K 

CALCULATE  MASS  FLUX  AT  RIGHT  OF  CELL 
IF  (ABS(URR) .LE.UMlN)  GO  TO  620 
UVMAX=TRNSFC^DX  1 1 ) /DT 
IF  ( A8S  ( URR )  •  LT » UVMAX )  GO  TO  670 
IF  (UKR.GT.O.)  GO  TO  660 
URR=-UVMAX 


PH23680 

PH23690 

PH23700 

PH23710 

PH23720 

PH23730 

PH23740 

PH23750 

PH23760 

PH23770 

PH23780 

PH23790 

PH23800 

PH23810 

PH23820 

PH23830 

PH23840 

PH23850 

PH23860 

PH23870 

PH23880 

PH23890 
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i  ! 


6oQ 
’6?0 
c  ' 

660 


690 

700 

7i0 

72Q 


C 

760 

C 


740 

750 


C 

C 


C 

750 


IF 

IF 

IF 

IF 


IF 

60 

IF 

IF 

IF 


IF 

1) 


NOT  EMPTY 
TO  750 

Oh  K  IS  EMPTY 


•  i 

Vi 


GO  TO  670 
URR=UVMAX 

A.mmp=aMX  ( M)  /T AO  ( ,\l )  *TwOPDT*X ( I )  *URR 

SET  SPECIFIC  ENERGY  +  MOMENTUM 
IF  (NSUWE.NE.O)  GO  TO  690 
EAMMP= . 5* ( U l M ) **2+ V ( M ) **2) +AI X ( M> 

UAMMP=U(M) 

VAMMP=V(M) 

GO  TO  790 

IF  (URRoGT.O.)  GO  TO  700 
M=K+1 
GO  TO  680 
M=K 

GO  TO  680 

wSA=.5*(U(K)+U(K+D  ) 

ttSS=l.+(U(K+l)-U(K))*DT/( (DX(I+l)+DXCI))/2.0> 

URR=.VSA/WSB 

IF  (NSLAVE. NE.O)  GO  TO  650 
a  F  (URR)  720 » 620 » 640 
McK+l 
NSlvi 
GO  I’O  650 

CELL  K  IS 
(AMX(K+1) .GT.O.)  GO 

CELL  ON  RIGHT 
(U(K).LE.O.)  GO  TO  620 

SHOULD  MASS  GO  INTO  EMPTY  CELL 
UoEQ.l)  GO  TO  740 

(AIX(K-i)  .GT.ESESG.OR.AIX(K)  .GT.ESESG.OR.AMXCK-U/CTAUCI- 
1U) ) .LT. SOLID. OR. AMX(K)/(TAU(I)*DY(J> ) .GT. SOLID)  GO  TO  630 
GO  TO  620 

(AIX(K).GE.ESE5Q.0R.AMX(K)/(TAU(I)*DY{J>>.GE.RH0Z)  GO  TO 
TO  620 

(U(K) .GToO..AND.UfK+l) .LT.O.)  GO  TO  760 
(U+l)  .EQ.IMAX)  (j  TO  760 

CAMX(K+2) .GT.O..OR.U(K) .GE.0..OR.U(K+l) .GE.O.)  GO  TO  770 
K  AND  K+l  NOT  EMPTY  BUT  CELL  K+2 

is  Empty,  test  for  slaving  k+i  to  k 

CAIX(K).GE.ESESQ.0R.AIX(K+1) .GE.£SESQ.0R.AMXCK+1)/(TAU(I) 
■GE.RHOZ)  GO  TO  710 

YES*  SLAVE  K+l  TO  K 

NSLAVE=K+1 

N=I 

M=K 

GO  TO  710 

***  SSREFLECTIVESS  TREATMENT 
UMK=U(K)*AMX(K) 

UMKP=U ( K+i ) *AMX ( K+l ) 

WSA=T'*OPDT*X(I) 

UOTK=UMK/TAU(I) 
uotkp=umkp/tau ( 1+1 ) 

SB-UOTK+UOTKP 

~MM3=WS6*WSA 

UAMMP= i UOTK+U ( K ) +UOTKP+U ( K+l ) ) /WSB 
VAMMP= ( UOTK+V  C  K ) +UOTKP+V ( K+l ) ) /WSB 
SAV£K~AIX(K)+.5*(U<K)**2+V(K)**2> 

EAMMP= ( UOTK+SA VEK+UOTKP* (AlX(K+l)  +  .5*(U(K+l>  **2+V ( K+l ) **2  > ) ) 


PH23900 
PH25910 
PH23920 
PH2393U 
PH23940 
PH23950 
PH23960 
PH23970 
PH23980 
PH23990 
PH24090 
PH24010 
PH24020 
PH24030 
PH24040 
PH24050 
PH24060 
PH24070 
PH24080 
PH24090 
PH24100 
PH24110 
PH24120 
PH24130 
PH24140 
PH24150 
PH24160 
PH24170 
1)  *DY (PH24180 
PM24190 
PH24200 
630  PH24210 

PH24220 
PH2.4230 
PH24240 
PH24250 
PH24250 
PH24270 
*DY  C J) PH24280 
PH24290 
PH2430C 
PH24310 
PH24320 
PH24330 
PH24340 
PH24350 
Ph24360 
PH24370 
PH24380 
PH24390 
PH24400 
PH24410 
PH24420 
PH24430 
PH24440 
PH24450 
/WSB  PH24460 
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f- 

l 

GO  TO  790 

:§ 

PH24470  -  i 

... 

1  •  i\j 

ir  ( I « EG « 1 )  GO  To  710 

PH24Ii8Q 

1  7ou 

IF  (AMXU-1)  .NE.O.  .OrUU(K-i-l) . LE . 0 . . OR . U ( K) .LE. 0 . )  60  TO  710 

PH24490 

SHOULD  K  BE  SLAVED  TO  K+l 

DUO/lKfin 

*  1  IC.TV  w  v 

IF  IAIX(K)  <,Gt.ES£SQ.OR.AIX(K+l)  .GE.ESESQ.OR.AMX<K)/(TAUCI>*DY( J>  > 

.PH24510 

1GE.KH0Z)  GO  TO  710 

PH24520 

c 

YES#  SLAVE  K.  TO  K+l 

PH24530 

* 

NSLAV£=K 

PH24540 

N— I+l 

PH24550 

l-'.-Kv  1 

PH24560 

- 

GO  TO  710 

PH24570 

c 

WILL  K  BECOME  MORE  THAN  EMPTY 

PH24580 

79q 

IF  (AdS(AMMP) .LT.AMX{K)*R0EPS.AND.A3S(AMMP) .LT.R0EPS*AMXCK+1>  >  AMMPH24590 

lP  =  Uc 

PH24600 

\*SOUT  =  0. 

Ph24610 

ivSA=0 . 

PH24620 

i'.Sb—'J  o 

PH24630 

IF  (AMMPoGT.O.)  GO  TO  830 

PH24640 

i‘.SA— — AMMP 

PH24650 

auo 

-F  (AMPY.GT.Q.)  GO  TO  840 

PH24660 

1 

aSA=WSA-AMPY 

PH24670 

I  810 

IF  (GAMC(J) oLT.O. )  GO  TO  850 

PH24660 

i 

SA— ,.b/-,vGAMC  ( J) 

PH24690 

I  820 

IF  (AMMYoLToO.)  GO  TO  860 

PH24700 

| 

WSA=WSA+AMMY 

PH24710 

I 

GO  TO  870 

PH24720 

s  8oo 

WSB=AMMP 

PH24730 

1 

GO  TO  800 

PH24740 

-  SHO 

wsb=wsb+ampy 

PH24750 

GO  TO  810 

PH24760 

i  6bO 

v.SOUT=-GAMC(J) 

PH24770 

GO  TO  820 

PH24780 

;  |  -  8oO 

wSOUT=WSOUT-AMMY 

PH24790 

I  87o 

DELM=WSA-WS3-WS0UT 

PH24800 

• 

IF  (AMX(K)+DELM«G£.Oo )  GO  TO  970 

PH24810 

C 

***  INTERMEDIATE  PRINT  FOR  CELLS  OVER-EMPTYING. 

PH24815 

IF  (INTER.EQ.Q)  GO  TO  880 

PH24820 

WRITE  (6# 1290)  I # J » AMX ( K ) » OELM # AMMY » GAMC ( J ) » AMPY # AMMr 

PH24830 

680 

IF  (WSOUT oGT*AMX (K# )  GO  TO  920 

PH24840 

C 

***  0TH£RWISE»MAKE  WS8  PLUS  WSOUT  EXACTLY 

PH24850 

C 

***  EQUAL  TO  AMX(K) 

PH24860 

WS=AMX(K) -WSOUT 

PH24870 

IF  CAMMPoGToQ.)  GO  TO  900 

PH24880 

AMPY=WS 

PH24890 

890 

DELM=WSA-WSOUT-AMMP~AMPY 

PH24900 

C 

***  INTERMEDIATE  PRINT  FOR  OVER-EMPTIED  CELL  AFTER 

PH24902 

1  c 

***  RtGHT  AND/OR  TOP  FLUXES  ADJUSTED. 

PH24904 

r 

f 

IF ( INTERoEQ* 0 >  GO  TO  970 

PH24906 

. ; 

WRITE (A# 1350)  AMX(K) ?DELM#AMMY#GAMC(J) #AMPY»AMMP 

PH24908 

! 

GO  TO  97C 

PH24910 

;  9Q0 

IF  (AMPYoGTcO.)  GO  TO  910 

PH24920 

AMMP=rtS 

PH24930 

GO  TO  890 

PH24940 

910 

AMMP=WS/ ( AMMP+AMPY) *AMMP  * 

PH24950 

AMPY=WS-AMMP 

PH24960 

GO  TO  890 

PH24970 

K 

c 

:  f 

***  CELL  OVER-EMPTIED  DOWN  OR  LEFT.  PUT  IT  BACK. 

PH24980 

f 

119 

L 

_ 

920  IF  (AMMP.LT.Q.)  30  TO  930 
AMMP-u. 

AMUH=0, 

AMVR=0. 

DELER=0. 

930  IF  (AMPY.LT.Q.)  GO  TO  940 
AmPY=Q. 

AMUT=Q. 

AMVT=0o 

UELET=0. 

940  MASS-AMX ( K ) 

UMOM=MASS*U(K) 

VMOM=MASS*V(K) 

ENGY=MASS*l.b*U(K)**2+.5*V(K)**2+AlX(K) ) 

MASS=MASS-AMMP 
UMOM=UMOM-AMMP*U ( K+l ) 

VMOM=VMOM-AMMP*V ( K+l ) 

t,N6Y=ENGY-AMMP*  ( . 5*U (K+l )  **2+  .  5*V  ( K+l >  **2+AIX (K+l > ) 

MASS^MASS-AMPY 

UMOM=UMOM-AMPY*U(U> 

VMOM=VMOM-AMPY*V(L) 

ENGY=ENGY-AMPY*(.5*U(L)**2+.5*V(L)**2+AIX(L) ) 

MASS=MA5S+AMMY 

UMOM=UMOM+AMMU 

VMOM=VMOM+AMMV 

EN6Y=ENGYtDELEB 

MASS=MASS+GAMC(J) 

UMOM=UMOM+FLEFT(J} 

VMOM=VMOM+YAMC(J) 

ENGY=ENGY+SIGC(J) 

WSA=-AM1N1(0.»GAMC(J))/WSOUT 
WS8=-AMIN1 ( 0  . » AMMY ) /wSOUT 
LB=K-IMAX 

IF  (LB.LT.O)  WSA=1. 

IF  (LB.LT.O)  GO  TO  950 
IF  (AMMY. EQ.O.. OR. WSB. EQ.O.)  GO  TO  950 
W5C=.hMX  ( LB )  +WSB*MASS 
WSD=AIX(LB)+.5*(U(LB)**2+V(LB)**2) 

U ( LB ) = ( AMX ( LB ) *U ( LB ) + WSB*UMOM ) /WSC 
V ( LB ) = ( AMX ( LB ) *V ( LB ) +WSB+VM0M ) /WSC 

AIX (LB) = ( AMX(LB) *WSD+W5B*ENGY) /WSC-.5* (U(LB) **2+V  (LB)  **2) 
AMX(LS)=WSC 

950  IF  (GAMC(J) .EQ.O.. OR. WSA. EQ.O.)  GO  TO  960 
WSC=AMX ( K-l ) +WSA+MASS 

WS0=AIX(K-1)+.5*(U(K-1)**2+V(K-1)**2) 

U ( K-l ) = ( AMX ( K-l ) *U ( K-l ) +WSA*UMOM) /WSC 
V ( K-i ) = ( AMX ( K-l )  *  V  ( K-l ) +WSA+VMOM ) /WSC 

AIX  ( K-l )  =  ( AMX  ( K-l )  * WSD+WSA*ENGY )  /WSC»  «. 5*  ( U  (K-l )  **2+V  ( K-l )  **2> 
AMX(K-1)=WSC 

C  ***  INTERMEDIATE  PRINT  FOR  OVER-EMPTIED  CELLS  AFTER 

C  MASS  PUT  BACK. 

960  IF  (INTER. EQ.O)  GO  TO  1100 

WRIT£(6» 1360)  AMX(K)»  DELM#  AMMY »  GAMC(J)»  AMPY *  AMMP  . 

GO  TO  1100 

970  IF  (AMPY. EQ.O.)  GO  TO  960 

C  CALCULATE  ENERGY  AND  MOMENTUM  FLUX  AT  TOP 

AMUT=AMPY*UAMPY 


PH24990 

ou^ c nnn 

r  iifcjuww 

PH25010 

PH25020 

PH25030 

PH25040 

PH25050 

PH25060 

PH25070 

PH25080 

PH25090 

PH25100 

PH25110 

PH25120 

PH25130 

PH25140 

PH25150 

PH25l6n 

PH25170 

PH25180 

PH25190 

PH25200 

PH25210 

PM25220 

PH25230 

PH2524D 

PH2525D 

PH25260 

PH25270 

PH25280 

PH25290 

PH25300 

PH25310 

PH25320 

PH25330 

PH25340 

PH25350 

PH25360 

PH2537Q 

PH25380 

PH25390 

PH25400 

PH25410 

PH25420 

PB25430 

PH25440 

PH25450 

PH25460 

PH25470 

PH25472 

PH25474 

PH25480 

PH2549C 

PH25500 

PH25510 

PH25520 

PH25530 


120 


f'J  IW 


C 

c 

c 

V, 

980 

990 

C 

C 

C 

C 

c 

1000 

c 

1010 

1020 


1030 

1040 

C 


AMVT=AMPY*VA.v,PY 

utLtT-AMrY»cAMPY 

is  this  at  top  boundary 

IF  (J.NE.JMAX)  60  TO  990 

Y£S#T0P.  ADJUST  ENERGY. 

ETH=ETH-DELET 
EMOT=EMOr+OELET 
tcpm=topm+ampy 
topmv=topmv+akvt 
T  0PMU=T  opmu+amut 

IS  AMPY  LARGE  ENOUGH  TO  TRIGGER  REZONE 
IF  (AMPY/(TAU(I)*DY(J) ) .GE.VT)  REZ=1. 

GO  TO  990 

AMPY=0.  SET  MOMENTUM  AND  ENERGY  FLUX=0. 

AMUT=0o 
AMVT=0  • 

OELET-O • 

IF  (AMMP.EQ.O.)  60  TO  1000 

CALCULATE  ENERGY  +  MOMENTUM  FLUX  AT  RIGHT 
AMUR=AMMP*UAMMP 
AMVR-AMMP*VAMMP 
DELER=AMMP*EAMMP 

IS  THIS  aT  RIGHT  BOUNDARY 
IF  (I.NE.IMAX)  GO  TO  1010 

YES#  RIGHT.  ADJUST  ENERGY. 

ETH=ETH-DELER 

EMOR=EMOR+DELER 

RTM=RTM+AMMP 

RTMV=RTMV+AMVR 

RTMUsRTMU+AMUR 

IS  AMMP  LARGE  ENOUGH  TO  TRIGGER  REZONE 
IF  (AMMP/(TAU(I)*DY(J>). GE.VT)  REZ=1. 

GO  TO  1010 

AMMP=0.  SET  MOMENTUM  AND  ENERGY  FLUX=0. 

AMUR=0. 

AMVR=0o 

DEL£R=0. 

REPARTITION  ENERGY  +  MOMENTUM 
IF  (DELM.EQ.O.)  GO  TO  1000 
WSA= o  5* ( U ( K ) **2+V ( K > **2 > 

S IGMU=-AMUT-AMUR+AMMU+FLEFT ( J ) 

SI6MV=-AMVT-AMVR+AMMV+YAMC(J) 

wS=DELM+AMX(K) 

IF  (WS.LE.O.)  GO  TO  1070 
UNEW=(SIGMU+AMX(K)*U(K) >/WS 
DELU=UNEW-U(K) 

IF  (ABS(DELU) .LT.UMIN)  GO  TO  1030 
U(K)=UNEW 

VNEW=(SIGMV+AMX(K)*VCK) )/WS 
DELVsVNEW-V(K) 

IF  (ABS(DELV) .LT.UMIN)  GO  TO  1040 
V(K)=VNEW 

WSa=-DELET-DELER+DELEB+SlGC(J) 

SlENEWs U A IX { K ) +WSA ) *AMX ( K ) + WSB ) /WS- . 5* ( U ( K ) **2+V ( K ) **2 ) 
D£LI=SIENEW-AIX(K) 

IF  (ABS(OELI) .GT.SIEMIN)  GO  TO  1050 

***  SUME  SUMS  ENERGY  FLUXES  TOO  SMALL  TO  USE.  SUME  IS 


PH25540 

DUOCCKfl 

•  i  w 

PH25560 

PH25570 

PH25580 

PH25590 

PH25600 

PH25610 

PH25620 

PH25630 

PH25640 

PH25650 

PH25660 

PH25670 

PH2560O 

PH25690 

PH25700 

PH25710 

PH25720 

PH25730 

PH257 ^0 

PH25750 

PH25760 

PH25770 

PH25780 

PH25790 

PH25800 

PH25810 

PH25820 

PH25830 

PH2S84Q 

PH25850  - 

PH25860 

PH25870 

PH25880 

PH25890 

PH25900 

PH25910 

PH25920 

PH25930 

PH25940 

PH25950 

PH25960 

PH25970 

PH25980 

PH25990 

PH26000 

PH26010 

PH26020 

PH26030 

PK26040 

PH26050 

PH26060 

PH26070 

PH26080 

PH26090 

PH26092 


121 


& 

s 


£r 


r>  ! 

*  * 


1050 

1060 

1070 


1090 


IF 

IF 

IF 


IF 


1110 

1126 

1130 


C 

C 

c 

1140 


C 

C 

C 

1150 

C 


1160 

1170 

1180 


subtracted  from  eth  at  the  end  of  this  routine. 

SUMfc=SUME+DELI*WS 
GO  TO  1060 
AIX(K)=SIENEW 
AMX(K)=WS 
GO  TO  1090 
AMX(K)=Q. 

AIX(K).“0« 

U(K)=0. 

V(K)=Q, 

GO  TO  1100 

DELM=0.  BUT  IS  THERE  INDIVIDUAL  FLOW 
(AKMP.NE.O.)  GO  TO  1020 
(AMPY.NE.O.)  GO  TO  1020 
(AMMY.NE.O.)  GO  TO  1020 
IF  (GAMC ( J) «NE. 0 . )  GO  TO  1020 
IF  (I.NE.I1)  GO  TO  1100 

IF  ( U  C  K ) . NE.O..OR,V(K) .NE»0.«OR.AIX{K) . NE . 0 . )  NRC=1 

***  SPECIAL  INTERMEDIATE  PRINT  FOR  CHECKING  ENERGY 

CONSERVATION  -  PRINTS  ONLY  IF  INTER  =  7  IN  INPUT  DECK. 
I  INTER. NE. 7)  GO  TO  1130 
ENERGY=DEL£R+OELET-SIGC (U) 

DO  1110  NN=1»JMAX 
ENERGY=ENERGY+SIGC (NN) 

CONTINUE 

DO  1120  LJ0=2#KMAX 

ENERGY=ENERGY+AMX ( L JD ) * ( AX X  <  L JD )  + . 5* ( U ( LUD  ) **2+V ( LUD ) **2 ) ) 
CONTINUE 

1* J»ENERGY 

AMPY # AMMP • AMMY t GAMC ( J ) 

WRITE  (6*1320)  DELET » DELER * DELEB >  S I GC l J ) 

CONTINUE 
GAMC (U) -AMMP 
FLEFT(U)=AMUR 
YAMC(J)=AMVR 
SIGC(J)=OELER 
AMMY=AMPY 
AMMU=AMUT 
AMMV=AMVT 
DELEB=DELET 

***  END  OF  U-LOOP. 

K=K+IMAX 
LL=K-IMAX 

IF  (U(LL).NE.Q..QR»V(LL).NE.Q..OR.AIX(LL).NE,0.>  NRT=1 
***  END  OF  I-LOOP. 

CONTINUE 

***  ADVANCE  ACTIVE  GRID. 

Il=Ii+NRC 
I2=I2+NRT 

IF  ( IMAX-I1)  1160*1170*1180 
Il-IMAX 
CONTINUE 

IF  (UMAX-12)  1190*1200*1210 


WRITE  (6*1300) 
WRITE  (6*1310) 
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PH26G94 

PH26100 

PH26110 

PH26120 

PH26130 

PH26140 

PH26150 

PH26160 

PH26170 

PH26180 

PH26190 

PH26200 

PH26210 

PH26220 

PH26230 

PH2&240 

PH2625C 

PH26260 

PH26262 

PH26264 

PH26270 

PH26280 

PH26290 

Ph26300 

PH26310 

PH26320 

PH26330 

PH26340 

PH26350 

PH26360 

PH2&370 

PH26380 

PH26390 

PH26400 

PH2641Q 

PH26420 

PH26430 

PH26440 

PH26450 

PH2G460 

PH26465 

PH26470 

PH26480 

PH26490 

PH26495 

PH26500 

PH26505 

PH26510 

PH26520 

PH26530 

PH26540 

PH26550 

FH26560 


iiyo 

l*OU 

1^10 

c 

1*20 


1*30 

C 

C 


c 

1240 


12o0 

1270 

i*ao 

C 

C 

c 

c 

c 

c 


1*90 

1300 

1310 


I2=JMAX_ 

Coni iNut 
GO  TO  1230 

***  NEGATIVE  MASS 

NK=315 

NR=9 

call  error 

SUM-0 • 0 

***  evaporate  low-dense  cells  on  basis  of  evap#  input 
parameter. 

00  12o0  I=1#I1 
K-I-l 

DO  1270  0=1# 12 

IF  ( AMX (K).EQ.O*)  GO  TO  1270 

IF  ( AMX ( K ) / ( T AU ( i ) *QY ( J) ) *GT« EVAP*RHINI )  GO  TO  1250 

t. S=  ( U  ( K )  **2+V  ( .<>  **2) /2. 0 

EVAPM=EVaPM+AMX(K) 

WS=AMX ( K ) * ( A I X ( K ) + WS ) 

EVAPEN=EVAPEN+WS 

ETH=ETH-WS 

EV APMUsEV APMU+ AMX (K)*U(K) 

EV APMV=E VAPMV+ AMX ( K ) *V i K ) 

***  INTERMEDIATE  PRINT  FOR  CELLS  EVA 'ORATED. 

IF  ( INTER. EQ.O)  GO  TO  1240 

WRITE (6# 1340)  I»J»AMX(K) #AIX(K)»U(K) #V(K) 

AMX IK) =0.0 
AIX(K)=0.0 
P(K)=0oO 
U (K) =0 . 0 
V(K)=0,0 
GO  TO  1270 

***  SET  NEGATIVE  INTERNAL  ENERGIES  TO  ZERO  WHEN  SN=0. 
(INPUT  PARAMETER). 

IF  (AIX(K)  ,GE.O..Of(.SN.GT.O.)  GO  TO  1270 

***  SUM  SUMS  NEGATIVE  INTERNAL  ENERGY  SET  TO  ZERO. 
SUM=SUM+AIX ( K ) *AMX ( K ) 

***  INTERMEDIATE  PRINT  FOR  CELLS  WHOSE  NEGATIVE 
INTERNAL  ENERGY  IS  SET  TO  ZERO. 

IF  (INTER. EQ.O)  GO  TO  1260 

WRITE  (6# 1330 )  I»J#AMX(K) .AIX(K) #U(K) #V(K)  * 

AIX(K)=Q. 

K=K+IMAX 

CONTINUE 

***  ETH  =  THEORETICAL  ENERGY  SUM#  USED  IN  EDIT  FOR 
ENERGY  CHECK. 


PH2e.570 

Fr.LoBBO 

PH2&590 

PH26600 

PH26610 

PH26620 

PH26630 

PH26640 

PH26642 

PH26644 

PH26650 

PH26&60 

PH2667G 

PH26680 

PH26690 

PH26700 

PH26710 

PH26720 

PH26730 

PH26740 

PH26750 

PH26760 

PH26765 

PH26770 

PH26780 

PH26790 

PH2680C 

PH26810 

PH26820 

PH26830 

PH26840 

Fh26842 

PH26S44 

PH26850 

PK26855 

PH26860 

PF26862 

PH26864 

PH26870 

PH26880 

PH26890 

PH26900 

PH2691Q 

PH26912 

PH26914 


***  EZPH2  =  ENERC .  SFT  TO  ZERO  IN  PH2  SINCE  TIME=0,  PH26916 

***  SUM  =  NEGAT1  “RNAL  EN^GY  SET  TO  ZERO  ON  THIS  PH26917 

CYCLE.  PH26918 

***  SUME  =  SUM  OF  THE  ENERGY  FLUXES  IGNORED  ON  THIS  CYCLE*  PH26919 
ETH=ETH-SUM-SUME  PH2G9P0 

EZPH2=EZPH2-SUME-5UM  PH26930 

RETURN  PH26940 

PH26950 

FORMAT  (5H  NEGM# 13# I4»4H  M=» 1PE14.7»6H  DELM=» 1PE14.7»6H  BOT=» 1PEPH2696Q 

114.7  #  7H  LEFT=#1PE14.7#6H  TOP=» 1PE14.7# 5H  RT=»1PE14.7)  PH26970 

FORMAT  (5H  1=  I3#6X#5H  J=  I3#6X#9H  ENERGY=1PE15.8>  PP26980 

FORMAT  (7H  AMPY=1PE15.8»6X#6H  AMMP=1PE15.8#6X»6H  AMMY-1PE15.8#9H  FH26990 
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1GAMC<J)=1PE15.8>  PH27000 

l?ion  Paduat  1 7u  rvci  CT:i  dpi  ft.tY.Aunri  cor  iDtriti  fl.tv.tunn  eo-ioric  o.qu  p 

""  '•!»!  *  »  »  II  WMW  •  —  *•  ivwtotBM  —  ••  «**  w  r\  »  W|  l>»^la  «■  M—  A  I  U«V*  Ur  #1  I  •  |  «£.  I  W  *  ■/ 

1SIGC( J)-1P£15»8)  PH27020 

1330  FORMAT  <4H  PH2»2I4»4H  M=,lP£15.8»6h  SIE=»1PE15.6»4H  U=»1PE15.8»PH27030 
14H  V=#1P£15*3»16H  SIE  SET  TO  ZERO)  PH27G40 

•1340  FORMAT  (4H  PH2»2X4»4H  M=,1P£15.8#6H  SIE=»1PE15.8»4H  U=»1PE15.8»PH27042 
14H  V=»1PE15.8»19K  CELL  EVAPORATED)  PH27044 

1350  FORMAT  (12H  ADJUST  FLUX»4H  M=» 1PE14.7»6K  DELM=»1PE14.7»6H  B0T=r  PH27045 
11P£14.7#7H  LEFT=#1PE14.7»6H  T0P=» 1P£14.7»SH  RT=»1PE14.7>  PH27046 

1360  FORMAT  (12H  ADJUST  MASS 1 4H  M=# 1PE14.7# 6H  DELM=» 1PE14.7»6H  B0T=>  PH27047 

11PE14.7#7H  LEFT=»1PE14.7»6H  T0»=»1PE14«7»5H  RT=*1PE14.7>  PH27048 

END  PH27050- 
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SUBROUTINE  RE20NE 


C 

C 


C 

c 


c 

c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 

c 

c 

c 


DIMENSION  AMX(2502)»AIX12502)»U(2502)  »V(2502>  #P(2502)  * 

1  X(52)  »XX(54)  »TAU<  52)  »JPM(52)  » 

2  Y (102)  »YY(1Q4)  »FLEFT(1Q2)»  Y,*MC<102>>  SIGCU02)# 

5  GAMC(102)» 

4  PK ( 15) »  Z(150)  . 

5  XP(26#5i)»YP(26.5i;» 

6  PH204)  »UL(204)  #PR<204)  » 

7  RSN(52) »  RST (52) * 


***  THE  FOLLOWING  EQUIVALENCES  MAKE  AVAILABLE 
XiO)'  Y(Q) »  DX ( 0 ) r  DY(0) 

EQUIVALENCE  (XX(2) t  X(l)),  ( YY(2) »  Y(D ) 

EQUIVALENCE  (DDX(2)»  DX(1)).  (DDY<2)»  DY(1) ) 

***  SPECIAL  EQUIVALENCES  FOR  PH2  ONLY 

EQUIVALENCE 


(ULrFLEFT) . 
(PL»GAMC»PR) » 


(UL1103)»YAMC)» 

(PL<1C3)»SIGC) 


***  SPECIAL  EQUIVALENCES  FOR  PH3  ONLY 
EQUIVALENCE 


1 

2 


(ULfRSN) » 
(PL.RST) . 
(P(157) »  VK) » 
(PC365) »CTB) » 


(P.UK). 
(P(313) .SNB) » 
(P(417)»RN0> 


REZ 
■  REZ 
REZ 
REZ 
REZ 
REZ 
REZ 
REZ 
REZ 
REZ 
REZ 


10 

20 

30 

40 

50 

60 

70 

80 

90 

100 

110 


8 

CMXP(5)  »CMYP(5) 

r  I J  ( 5)  * 

JK(5)  » 

REZ 

120 

9 

DXC52)  .DDX(54) 

#DY(102)  » 

DDY(104)  » 

REZ 

130 

S 

SNBC52)  #STB(52) 

rUK(52r3)  * 

VK(52»3)  .RH0(52»3> 

REZ 

140 

***  DIMENSIONED  ARRAYS 

REZ 

150 

***  Z-l 

BLOCK  is  saved 

ON  TAPE. 

REZ 

160 

COMMON 

z 

REZ 

170 

COMMON 

PK 

REZ 

180 

COMMON 

YY  » 

XX 

REZ 

190 

COMMON 

DDX. 

ddy 

REZ 

200 

COMMON 

AMX. 

AIX#  Ur 

V»  P 

REZ 

210 

COMMON 

TAU. 

JPM 

REZ 

220 

COMMON 

UL  » 

PL 

REZ 

230 

COMMON 

XP  » 

Yp  r  CMXP#  CMYP 

REZ 

240 

**»  NON-DIMENSIONED 

VARIABLES 

REZ 

250 

common 

AID  .  AMMV 

»  AMMY  rAMPY 

.AMUR  r AMUT 

fAMVR  f 

REZ 

260 

1AMVT 

.  DELEB 

rDELER  .DELET 

»DELM  rDTODX  »DXYMIN»EAMMP 

.EAMPY  » 

REZ 

270 

2E 

»  ERDUMP 

»I  »  13 

»IWS  »J 

»K  .KA 

»K3  f 

REZ 

280 

3LL 

»MD 

» ME  »  MZT 

»NERR  »nk 

.NPRINTf 

REZ 

290 

4NR 

»NRZ 

rNULLE  .PIDTS 

#siemin»snr 

»SNT  .STR 

.SOLID  » 

REZ 

300 

5SUM 

iTESTRH 

.TWOPI  .URR 

» WS  » WSA 

»WSB  »WSC 

.WFLAGF. 

REZ 

310 

6WFLA6L#  WFLAG° 

REZ 

320 

***  SPECIAL  EQUIVALENCES  FOR  EDIT 
EQUIVALENCE  (PRll)»  IJ) »  (PR(6).  JK) 

***  Z-STORAGE  EQUIVALENCES 

EQUIVALENCE  (Z(  D.PROB  >»(Z(  2) .CYCLE  )* 


REZ  330 
REZ  340 
REZ  350 
REZ  360 
REZ  370 
REZ  380 
REZ  390 
REZ  400 
REZ  410 
REZ  420 
REZ  430 
REZ  440 
REZ  45C 
REZ  460 
REZ  470 
REZ  480 
REZ  490 
REZ  500 
REZ  510 
REZ  520 
REZ  530 
REZ  540 
REZ  550 
REZ  560 
REZ  570 
REZ  580 


IPS 


1<Z( 

2(Z( 

3(Z( 

4(2( 

5(Z(  19) »NZ  )i 
6(Z(  23)»UN23  ) 

7(Z<  27).CVIS  ). 
8(Z(  3i)»UN31  >i 
9(Z(  35)  rwiMAX  ) 
EQUIVALENCE  . 
1(Z(  39) »80TM  ) 

2<Z(  43) .NUMSCA) 
EQUIVALENCE 
1(Z<  47) .11  ) 

2(Z(  51) »RH0FIL) 
3(Z(  55) » VT  ) 
4(Z<  59)»UN59  ) 

5(Z(  63)#T0PM  ) 

6(Z(  67) pPRYBOT) 
7(Z(  71) .REZFCT) 
8(Z(  75) »EVAP  ) 
9lZ(  79) » JJ  ) 
EQUIVALENCE 
1(Z(  83) » IVARDX) 
2(Z(  87) » INTER  ) 
3(Z(  91) »MC  ) 
EQUIVALENCE 
1(Z(  95) »REZ  ) 
2(Z(  99) »UN99  ) 

3(Z(103)»£VaPMV) 
4(Z(l07)»TAXRT  ) 
5(Z(111)*RHINI  ) 
6(Z(115)»RH0Z  ) 

7(Z(119)*ESCAPA) 
8(Z(123) .ESALPH) 
9(Z(127) .SSI  ) 
EQUIVALENCE 
1(Z(131)»FRTIME) 
2(2(135) »£MOR  ) 
3(Z(139) .STAB) 9 
4(2(143) »STT  ) 
5(2(147) »jPROJ  ) 


3) f OT  ) 
7) » ICSTOP) 
11) #STK1  ) 
15) .RHINIT) 


(Z(  4) 
(Z(  8) 
(Z(  12) 
(Z(  16) 
(2 (  20) 
(Z(  24) 
(2(  28) 
(Z(  32) 
(Z(  36) 


» NUMSP  ) 
»PIDY  > 
»NUMREZ) 
#PROJI  ) 
»NREZ  ) 
fDMlN  ) 
»STK2  ) 
»NRC  ) 
* UMAXA  ) 


(2(  40)  »BOTf-W  ) 
( 2 (  44)  PRLIM  ) 


48)  t 
52) » 
56)  # 
60)  # 
64)  . 
68)  * 
72)  t 
76)  * 
83)  » 


12  ) 

TARGV  ) 
N6  ) 

M1Q  ) 
BOTMU  ) 
PRYTOP) 
TARSI  ) 
ECK  ) 
NMP  ) 


(Z(  84) »T  ) 
(Z(  88)»TAY80T) 
(Z(  92) »MR  ) 


(Z(  96) 
(Z(100) 
(Z(104) 
(2(103) 
(Z(U2) 
(2(116) 
(Z(120) 
(Z(124) 
(Z(i28) 


•NODUMP) 
»EVAPM  ) 
#EZPH2  ) 
»IDNMAP) 
»VINI  ) 
»ESA  ) 
»ESESP  ) 
»ES3ETA) 
»SS2  > 


» (2(132) #EOR  ) 
» (2(136) »DXF  ) 
(2(143) rXIENRG) » 
» (2(144) #DTMIN  ) 
» (2(148) #CNAUT  ) 


( 2  (  5) » 
(2t  Q* 

III  13) 
(2(  17) 
(2(  21) 
(Z(  25) 
(Z(  29) 
(Z(  33) 
(Z(  37) 


NFRELP) 

.  TDDUII 

*  *  nv 

fETH 
»UN17 
»  AMD.M 
» JSTR 
»STEZ 
» IMAX 
»KMAX 


\  .  I  71 
»»»*•» 


6)  »NDUMP7)  t  HL'Z  590 


(Z(  41)»NUMSPT) 
(Z(  45)»PRDELT) 


(2(  49) 
(Z(  53) 
(2(  57) 
(2(  61) 
(Z(  65) 
(Z(  69) 
(Z(  73) 
(2(  77) 
(2 (  81) 


»IPCYCL) 
»N3  ) 
rRTM  ) 
•  Nil  ) 
»SN  ) 
t  PRXRT  ) 
.PROJU  ) 
»NECYCL> 
»  Y2  ) 


(Z(  85) »NMPMAX) 
(Z( .89>#TAYT0P) 
(Z(  93) »MZ  ) 


(2(  97) 
(2(101) 
(2(105) 
(Z(109) 
(2(113) 
(2(117) 
(Z(121) 
(2(125) 
(Z(129) 


rUN97  ) 
»EVAPDJ) 
rSNL  ) 
• IPRMAP) 
fFINAL  ) 
»ESEZ  ) 
»ESESQ  ) 
»  ESCAPE)) 
»UMIN  ) 


(2(133) »EOT  ) 
(2(137) rDYF  ) 
(2(141) »XKENRS) 
(2(145) rTRNSFC) 
(2(149) »B8AR  ) 


I  A  \  .  ftTui  • 
aw#  r  r\  *  nw 

14) #UN14 
18)»XMAX 
22) .UVMAX 
26)»DTNA 
30) *NC 
34) » IMAXA 
38) .KMAXA 


(Z(  42)#C2ER0  )> 
(Z(  46) .PRFACT) 


(Z(  50) 
(2(  54) 
(Z(  58) 
(Z(  62) 
(Z(  66) 
(Z(  70) 
(2(  74) 
(Z(  78) 
(Z(  82) 


.TSTOP  )» 
» IVARDY ) * 
.RTMV  )» 
» GAMMA  >» 
tTOPMV  )t 
.CYCPH3) * 
.  BBOUND) t 
.II  )t 
»  EZPHl  ) 


(Z(  86) »PMIN  )» 
(Z(  90) » lEMAP  )» 
(Z(  94) .MB  ) 


(Z(  98) 
(Z(102) 
*7(106) 
110) 
v  .114) 
(2(118) 
(Z(122) 
(Z(126) 
(2(130) 


.UN98  ) . 
.EVAPMU) » 
»STL  )» 
»ROEPS  )» 
» IVMAP  )» 
»ESB  >. 
»ESES  )» 
» IUMAP  )» 


(2(134) r£OB  U 
(Z(138) rRHOMIN) » 
(2(142) »XTENRG) 
(2(146) »EM0T  )» 
(2(150) »EM0B  ) 


END  OF  COMMON 


***  INITIALIZE  P-STORAGE.  CDT  CALLED  AGAIN  AND  PRESSURES 
RECALCULATED  AFTER  GRID  REZONED  AND  BEFORF  PH1#PH3 
AND  PH2  ARE  CALLED. 


DO  10  K-2.KMAX 
P(K)=0. 
CONTINUE 
NJMAX=JMAX/2 


rvr  •*  a  a 

r\L6  ouw 

RE2  610 
RE2  620 
RE2  630 
RE2  640 
RE2  650 
RE2  660 
RE2  670 
RE2  680 
RE2  690 
REZ  700 
REZ  710 
REZ  720 
REZ  730 
REZ  740 
REZ  750 
REZ  760 
REZ  770 
REZ  780 
REZ  790 
REZ  800 
REZ  810 
REZ  820 
REZ  830 
REZ  840 
REZ  850 
REZ  860 
REZ  870 
REZ  880 
REZ  890 
REZ  900 
REZ  910 
REZ  920 
REZ  930' 
REZ  940 
REZ  950 
REZ  960 
REZ  970 
.REZ  980 
REZ  990 
REZ1000 
REZ1010 
-REZ1020 
REZ1030 
REZ1040 
REZ1050 
•REZ1060 
REZ1070 
REZ1072 
REZ1074 
REZ1076 

REZ1030 

REZ1U90 

REZUOO 

REZ1110 


IF  ( IMAX.EQsl)  GO  TO  29 
NIMAX=IMAX/2 

nn  Tn  7(1 

VV  »  W  I  » 

***  1-D 

IMAX=2 
NJKAX— 1 
K=2 

L=2*JMAX+2 


REZU20 
KEZiidO 
REZ1140 
REZ1145 
REZ1150 
REZ1160 
REZ1170 
RE  7.1 160 


***  STORE  PROPERTIES  TEMPORARILY  IN  UNUSED  PART  OF  ARRAYS.  REZ1185 

DO  30  J=1»JMAX  REZ1190 

AMX(L)=AMX(K)  REZ1200 

U(L)=U(K)  '  REZ1210 

V(U=V(K>  REZ1220 

AIX(L)=AIX(K)  REZ1230 

K=K+1  REZ1240 

L=L+1  REZ1250 

CONTINUE  REZ1260 

K=2  REZ1270 

L=2*JMAX+2  REZ1280 

***  ADD  ANOTHER  COLUMN  OF  CELLS.  EACH  CELL  IN  NEW  COLUMN  REZ1282 

WILL  HAVE  SAME  VELOCITIES  AND  SIE  AND  3  TIMES  THE  REZ1284 

MASS  OF  AXIS  CELL.  REZ1286 

DO  50  J=1#JMAX  REZ1290 

DO  40  1=1 »2  REZ1300 

AMXUO=AMX(L)  REZ1310 

U(K)=U(L)  REZ1320 

V(K)=VIL)  .  REZ1330 

AIX(K)=AIX(L)  "  REZ1340 

K=K+1  REZ1350 

AMX(U=3.*AMX(L>  REZ1360 

CONTINUE  REZ1370 

L=L+1  REZ1360 

L=2*JMAX+1  REZ1390 

***  ADJUST  ETH  BY  AOOING  ENERGY  OF  CELLS  IN  NEW  COLUMN.  REZ1395 

DO  60  K=3»L*2  REZ1400 

ETH=ETH+AMX(K)*(AlX(K)+(V(K>**2)/2.>  REZ1410 

CONTINUE  SEZ1420 

DO  120  J=1*NJMAX  REZ1430 

K=(J-l)*NIMAX+2  REZ1440 

L=(J-l)*2*lMAX+2  REZ1450 

00  110  I=1»NIMAX  REZ1460 

M=L+IMAX  REZ1470 

***  SUM  MASS  OF  FOUR  CELLS  TO  BE  made  INTO  ONE  CELL.  REZ1475 

WSA=AMX(L)+AMX(M)+AMX(L+1>+AMX{M+1)  REZ1480 

IF  (WSA.EQoO.)  GO  TO  80  REZ1490 

*♦*  SUM  KINETIC  ENERGY  OF  FOUR  CELLS.  REZ1495 

WSB=AMX{L)*CU(L>**2+V(U**2)+AMX(M>*CU(M)**2+V<M>**2>+AMXCL+1>*(U{REZ1500 
1L+1 ) **2+V ( L+l ) **2) +AMX ( M+l ) * ( U ( K+l ) **2+V (  M+l ) **2 )  REZ1510 

***  COMPUTE  VELOCITIES  OF  NEW  CELL  FROM  VELOCITIES  OF  REZ1512 

THE  FOUR  CELLS.  .  REZ1514 

U ( K )  =  ( U ( L ) *AMX (L)+U(M) *AMX ( M ) +U < L+l > *AMX ( l+l ) +U ( M+l ) *AMX ( M+l ) > / WSAREZ1520 
V ( K )  =  ( V ( L  >  * AMX  <  L ) + V ( M ) * AMX  <  M ) + V ( L+ 1 >  * AMX ( L+l ) + V ( M+l > ♦ AMX 1 M+l ) > /WSAREZ1530 
***  COMPUTE  INTERNAL  ENERGY  OF  NEW  CELL.  REZ1535 

AIX(K)=AIX(L)*AMX(L)+AIX(M)*AMX(M)+AIX(L+1)*AMX(L+1)+AMX(M+1)*AIX(REZ1540 
1M+1)  REZ1550 

AMX(K)=WSA  REZ1560 

WS=U(K)**2+V(K)**2  REZ1570 


127 


E=AlX(K)*WSB/2.u 

.C  ***  COMPUTE  SIE  OF  NEW  CELL. 

AI X  ( K )  =E/AMX  (K)-.5*WS 
IF  (K-2)  100»100#9f: 
c  ***  new  cell  empty. 

80  AMXIK)=0. 

AIX(K)=0. 

U(K)=0. 

V(K)=0. 

C  ***  INITIALIZE  STORAGE  OF  CELL  GUANTIES  OF  OLD  GRID. 

90  AMXCL)=0.0 
U(L>=0.0 
V (L) =0.0 
AIX (L)=0. 0 
AMX(M)=0.0 
U(M)=0.0 
V (M)=0.0 
AIX (M) =0.0 
AMXlL+1)— 0.0 
U(L+1>=0,0 
V(L+1J=0.0 
AIXtL+1)— 0.0 
AMX(M+1)=0.0 
U(M+1)=0.0 
V(Mt1)=0.0 
AIXCM+D-O.Q 
100  K=K+1 

L=L+2 

C  ***  END  OF  I —LOOP 

*110  CONTINUE 

C  ***  END  OF  J-l.OOP 

.120  CONTINUE 

C  ***  OLD  PART  OF  ENLARGED  GRID  HAS  NOW  BEEN  REZONED. 

C  PROPERTIES  OF  NEW  PART  OF  GRID  WILL  BE  ASSIGNED 

C  BELOW. 

C 

C  ***  CALCULATE  NEW  DY'S  UP  TO  EDGE  OF  OLD  GRID  BY 

C  COMBINING  THE  OLD  DY'S  .  CALCULATE  NEW  Y*S  FROM 

C  THE  NEW  DY'S. 

DO  130  J=1»NJMAX 
D Y ( U ) =D Y ( 2* J-l )  +0  Y  ( 2*  J ) 

Y  ( J)=Y  (J-D+DY  (  J) 

130  CONTINUE 

C  ***  ASSIGN  THE  VALUE  OF  THE  LAST  DY  CALCULATED  ABOVE 

C  TO  ALL  CELLS  ABOVE  THE  OLD  GRID. 

NJMAX1=NJMAX+1  -  i 

DO  140  U=NJMAX1»JMAX 
DYi J)=DY (NJMAX) 

Y(J)=Y(vl-l)+DY(J) 

140  CONTINUE 

C  ***  IMAX  IS  SET  TO  2  IF  DOING  A  1-D  PROBLEM 

IF  (IMAX. EG. 2)  DX(2)=DX(1) 

.  DX<i)=DX(l)+DX(2> 

X(1)=DX(1) 

WS=X(1J**2 

TAU(i)=PIDY*ttS 

**«  ARE  YOU  DOING  A  1-D  PROBLEM 


REZ158C 

REZ1585 

RE21590 

REZ1600 

REZ1605 

REZ1610 

REZ1620 

REZ1630 

REZ1640 

REZ1650 

REZ1660 

REZ1670 

REZ1680 

REZ1690 

REZ1700 

REZ1710 

REZ1720 

REZ1730 

REZ1740 

REZ1750 

REZ1760 

REZ1770 

REZ1780 

REZ1790 

REZ1800 

REZ1810 

REZ182C 

REZ1830 

REZ1835 

REZ1840 

REZ1845 

REZ18S0 

REZ1852 

REZ1854 

REZ1856 

REZ1860 

REZ1862 

REZ1864 

REZ1870 

REZ1680 

REZ1890 

REZ1900 

REZ1902 

REZ1904 

REZ191Q 

REZ1920 

REZ1930 

REZ1940 

REZ1950 

REZ1955 

REZ1960 

REZ1970 

REZ1980 

REZ1990 

REZ2000 

REZ2005 


C 


IF  i IMAXtEQ.2)  GO  TO  300  _  REZ201Q 

***  CALCouATt  NtW  0X*S  OUT  TO  EDGE  OF  OLD  GRID  BY  RE42012 

COMBINING  OLD  DX*S.  CALCULATE  NEW  X»S  AND  CELL-FACE  REZ2014 

AREAS  FROM  THE  NEW  DX*S.  REZ2016 

DO  150  I=2»NIMAX  REZ2020 

0X(I>=DXl2*I-i>+DX<2*I)  REZ2030 

X(I)=X(I-1)+DX(I>  REZ2040 

*SA=X(I>**2  REZ2050 

TAU(I)=PIDY*(WSA-WS>  REZ2060 

WS-WSA  REZ2070 

CONTINUE  REZ2080 

***  ASSIGN  THE  VALUE  OF  THE  LAST  DX  CALCULATED  ABOVE  REZ2082 

TO  ALL  CELLS  TO  THE  RIGHT  OF  THE  OLD  GRID*  REZ2084 

NIMAX1-NIMAX+1  REZ2090 

DO  160  I=NIMAX1»IMAX  REZ2100 

DX(I)=DX(NIMAX)  REZ2110 

X { I ) ( I-l ) +DX { I )  REZ212Q 

WSA=XII)**2  REZ2130 

TAU(IJ=PIDY*(WSA-WS)  REZ2140 

WS=WSA  REZ2150 

CONTINUE  REZ2160 

REZ2170 

***  INITIALIZE  CELL  BOUNDARIES  REZ2180 

REZ2190 

JPB-0  REZ2200 

JPA=0  REZ2210 

JTB=0  REZ2220 

JTA-0  REZ2230 

IPRT=Q  REZ2240 

ITRT=Q  REZ2250 

REZ2260 

IF  ( PR YTOP . LE  *  Y i N JM AX ) . AND  *  PRXRT • LE  *  X ( N I M AX ) . AND . TAYTOP . LE . Y i NUM AXREZ227G 
1;.AN0.TAXRT*LE.X(NIMAX))  GO  TO  300  REZ2280 

REZ2290 

***  COMPUTE  JPBr  JPA  -  BOTTOM  AND  TOP  CELL  BOUNDARIES  OF  REZ2300 

PROJECTILE  REZ231C 

REZ2320 

IF  (PRY80T.LT.0. .OR. (PRYTOP.LE. Y(NJMAX) .AND.PRXRT.LE.XCNIMAX) ) )  GOREZ2330 
1  TO  230  REZ2340 

J=0  REZ2350 

IF  (PRYBOT.EQ.O.)  GO  TO  180  REZ236C 

DYSUM=0.  REZ2370 

DO  170  J=1»JMAX  REZ2380 

DY5UM=DYSUM*0Y(J)  REZ2390 


***  INITIALIZE  CELL  BOUNDARIES 


JPB-0 

JPA=0 

JTB=0 

JTA-0 

IPRT=Q 

ITRT=Q 


***  COMPUTE  JPBr  JPA  -  BOTTOM  AND  TOP  CELL  BOUNDARIES  OF 
PROJECTILE 


REZ2340 

REZ2350 

REZ236C 

REZ2370 

REZ2380 

REZ2390 


IF  (PRYB0T,GE.0YSUM-.5*DY(J>.AND.PRYB0T.LT.DYSUH+.5*DY(J*1>>  GO  TOREZ2400 


1  160 
CONTINUE 
GO  TO  230 
JPB=MINC(J+Ir JMAX) 
DO  190  J=JPBrJMAX 
DYSUM=DYSUM+OY(J) 


REZ2410 

REZ2420 

REZ2430 

REZ2440 

REZ2450 

REZ2460 


IF  CPRYT0P.GE.DYSUM-.5*DY(J),AND,PRYT0P.LT.DYSUM+.5*DY(J+D)  GO  TOREZ2470 


1  200 
CONTINUE 
JPA— J 


***  COMPUTE  IPRT  -  RIGHT  CELL  BOUNDARY  OF  PROJECTILE 


REZ2480 

REZ2490 

REZ2500 

REZ2510 

REZ2520 


ion 


REZ2530 

DXf jM=G.  REZ2540 

DO  210  1=1# IMAX  REZ23&0 

DXSUM=DXSUM+DX(I)  REZ2560 

IF  (PRXRnGE.DXSUM-.5*DX(I>.AND.PRXRT.LT.DXSUM+.5*DX(X+l>)  60  TO  2REZ2570 
120  REZ2580 

CONTINUE  REZ2590 

1PRT-I  PEZ2600 

REZ2610 

***  COMPUTE  UTB#  UTA  -  BOTTOM  AND  TOP  CELL  BOUNDARIES  OF  REZ2620 
TARGET  REZ2630 

REZ2640 

IF  ( TAYBOT.LT. 0. .OR. (TAYTOP.Lt. Y(NJMAX) .AND.TAXRT.LE.X(NIMAX) ) )  G0REZ2650 
1  TO  300  REZ2660 

U=0  REZ2670 

IF  (TAYBOT.EQ.O.)  GO  TO  250  REZ2680 

DYSUM=0.  REZ2690 

DO  240  U=1 »UMAX  REZ27Q0 

DYSuM=DYSUM+DY(J)  REZ2710 

IF  CTAYB0T.GE.DYSUM-.5*DYIU).AND.TAY30T.LT.DYSUM+.5*DY(U+1>>  GO  TOREZ2720 
1  250  REZ2730 

CONTINUE  REZ2740 

GO  TO  300  REZ2750 

UTB=MIN0(U+1#UMAX)  REZ2760 

DO  260  U=UT3#UMAX  REZ277Q 

DYSUM=DYSUM+DY ( U )  REZ2780 

IF  (TAYTOP.GE.DYSUM-.5*DY(J).AN0.TAYT0P.LT.DYSUM+.5*DY(J+l>>  GO  TOREZ2790 
1  270  REZ2800 

CONTINUE  REZ2310 

UTA=J  REZ2320 

REZ2830 

***  COMPUTE  ITRT  -  RIGHT  CELL’  BOUNDARY  OF  TARGET  REZ2840 

REZ285Q 

DXSUM=0.  REZ2860 

DO  280  1=1# IMAX  REZ2870 

DXSUM=DXSUM4DX ( I )  REZ2880 

IF  (TAXRT.G£.DXSUM-.5*DXU>.AND.TAXRT.LT.DXSUM+.5*DXII+1>>  60  TO  2REZ2890 
190  REZ2900 

CONTINUE  REZ2910 

ITRT=I  REZ2920 

CONTINUE  REZ2930 

***  REDEFINE  IMAX  AND  UMAX  FOR  ORDERING  THE  K  ARRAYS  REZ2932 

BELOW.  REZ2934 

IMAX=NIMAX  •  REZ2940 

UFILB=UPA+i  REZ2950 

UFILA=UTB-1  REZ2960 

JMAX-NJMAX  REZ2970 

11=11/2  REZ2.980 

12=12/2  REZ2990 

***  IS  THIS  A  1-0  PROBLEM  REZ2995 

IF  (IKAX.GT.l)  GO  TO  320  REZ3000 

***  YES. ADD  TaRGET  MATERIAL  REZ3005 

UMP1=UMAX+1  REZ3010 

UMAX=2*UMAX  REZ3C20 

DO  310  U=UMP1 » UMAX  REZ3030 

K=Jvl  REZ3040 

AMX  CK) =RHINIT*TAU (1)*DY(U)  REZ3050 


non 


IF  (TARGI.GT.Q.)  I2=J 

a  t  V  (  k  }  -r  AO(5 T 
ETH=£TH+AMX(K)*AIX(K) 


/'AkiT  t  Kit  IL‘ 

VWIS  I  4MVU 


JPR0J=JPR0J/2 

11=1 

GO  TO  520 

***  PREPARE  TO  SHUFFLE  K  ARRAYS  SUCH  AS  TO  PRESERVE 
K=(J-1)*IMAX+I+1»  THEN  ADD  MATERIAL  TO  NEW  PART 
OF  GRID. 

DO  360  N-l»JMAX 

J=JMAX+1-N 

K=(J-1)*IMAX+1+IMAX 

L= ( J-l ) * ( IMAX+IMAX) +1+IMAX 

DO  350  1=1, IMAX 

AMXIL)=AMX(K) 

AIX(L>=AIX(K) 

U(L)=U(K) 

V (L) =V (K) 

IF  (J-l)  340*340,330 

AMX(K)=0.0 

AIXIK)=0.0 

VCK)=0.0 

U(K)=0«0 

K=K-1 

L=L-1 

CONTINUE 

CONTINUE 

***  REDEFINE  IMAXiJMAX  SO  THEY  WILL  REPRESENT  number 


REZ3Q60 

REZ3070 

REZ3060 

REZ3090 

REZ3100 

REZ3110 

REZ3120 

REZ3130 

REZ3140 

REZ3145 

REZ3150 

REZ3160 

REZ3170 

REZ3180 

REZ3190 

REZ32C0 

REZ3210 

F._Z3229 

REZ3230 

REZ3240 

REZ3250 

REZ3260 

REZ3270 

RE23280 

REZ3290 

REZ3300 

REZ3310 

REZ3320 

REZ3322 


OF  COLUMNS  AND  ROWS  IN  NEW  GRID  (SAME  AS  IN  OLD  GRID).  REZ3324 
IMAX=NIMAX*2  REZ3330 

JMAX=NJMAX*2  REZ3340 

IL=NIMAX+1  REZ3350 

JL=NJMAX+1  RE23360 

IF  ( PR YTOP . LE * Y ( N JMAX ) .AND.PRXRT.lE.X(NIMAX) •AND.TAYTGP.LE* Y (NJMAXREZ3370 
1)oAND.TAXRT.L£.X(NIMAX;>  GO  TO  510  REZ338G 

***  ADO  APPROPRIATE  MATERIAL  REZ3390 

IN  CELLS  ABOVE  (BUT  NOT  TO  THE  RIGHT  OF)  OLD  GRID.  REZ3395 

DO  430  X=1*NIMAX  REZ3400 

K=(JL-1)*IMAX+I+1  REZ3410 

DO  420  J=JL» JMAX  RE23420 

IF  (PRYBOT.LT.O.)  60  TO  370  REZ3430 

IF  CJ.GE.JPB.AND.J.LE.JPA.AND.I.LE.IPRT)  GO  TO  390  REZ3440 

***  NOT  PROJECTILE-MATERIAL  REZ3450 

IF  (RHOFIL.EQ.0 » )  GO  TO  380  REZ3460 

IF  (J.GE.JFILB.AND.J.LE.JFILA)  GO  TO  400  REZ3470 

***  NOT  FILLER-MATERIAL  REZ3480 

IF  (TAYBOT.LT.O.)  GO  TO  420  REZ3490 

IF  (J.GE.JTB.ANC.J.LE.JTA.AND.I.LE.ITRT)  60  TO  410  REZ3500 

***  NOT  TARGET.  THUS, VACUUM.  REZ3510 

GO  TO  420  REZ3520 

***  ADD  PROJ.  MATERIAL  REZ3&30 

AMX  (  K )  =RHINI*TAU  ( I ) *DY ( J)  REZ3540 

IF  (PROJU.EQ.O..AND.VINI.EG.O..AND.PROJI.EQ.O.)  GO  TO  420  REZ3550 

IF  (I.GT.I1)  11=1  REZ3560 

IF  (J.GT.I2)  12= J  REZ3570 

U(K)=PROJU  REZ3580 


,i  J 


490 

500 

C 

c 

•  510 
C 
C 


fr  7 


V(K)=VINI 

a:x(k)=proji 


60  ro  420 


*  -  *  *  »•  *  i  »  m 

***  ml/li  r  xuuc-rv 


AMX  (K)  =RH0FIL*TAU(I )  *DY  ( J) 

GO  TO  420 

***  ADD  TARGET  MATERIAL 
AMX(K) =RHINIT*TAU{ I) *DY ( J) 

IF  (TARGV.EQ.O..AND.TARGI.EQ.O.)  GO  TO  420 

IF  (I.GT.I1)  11= I 

IF  (J.GT.12)  I2-J 

V (K)=TARGV 

AIX(K)=TARGI 

K=K-t-IMAX 

CONTINUE 

***  ADD  APPROPRIATE  MATERIAL  TO  CELLS  ON  THE  RIGHT 
OF  THE  OLD  GRID. 

DO  500  I=IL»IMAX 
K=I+1 

DO  490  J=1»JMAX 
IF  (PRYBOT.LT • 0 o  >  GO  TO  440 

IF  (J.GE. JP8.AND. J.LE. JPA. AND* I  .LE» IPRT .*  60  TO  460 
***  NOT  PROJECTILE  MATERIAL. 

IF  (RHOFIL.EQ.O.)  GO  TO  450 
IF  ( J » GE • JF I LB • AND » J • L£  » JF I L A )  GO  TO  470 
***  not  filler  material. 

IF  ITAYBOTcLT. 0.)  GO  TO  490 

IF  (J.GE.JTB.AND.J.LE.JTA.AND.I.LE.ITRT)  go  TO  480 
***  NOT  TARGET  MATERIAL.  THUS.VaCUUM. 

GO  TO  490 

***  ADD  PROJECTILE  MATERIAL. 

AMX(K)=RHINI*TAU( I ) *OY ( J) 

IF  ( PRO JU o EQ . 0 . » AND • V INI • EQ • 0 • • AND . PRO Jl • EQ . 0 . )  GO  TO  490 

IF  (IoGT.il)  11=1 

IF  (JoGT.12)  I2=J 

U(K)=PROJU 

V(K)=VINI 

AIX(K)=PROJI 

GO  TO  490 

***  ADD  FILLER. 

AMX ( K ) =RH0F IL*T AU (I)*DY(J) 

GO  TO  490 

***  ADD  TARGET  MATERIAL. 

AMX(K)=RHINIT*TAU(I)*DY(J) 

IF  (TARGV.EO.O. .AND.TARGI .EQ.O. )  GO  TO  490 

IF  U.GT.Il)  11=1 

IF  (J.GT.I2)  I2=J 

V(K)=TARGV 

AIX(K)=TARGI 

KsK+IMAX 

CONTINUE 

***  REDEFINE  JPROJ, USUALLY  J-INDEX  OF  TOP  CELL  IN 
PROJECTILE  (INPUT  PARAMETER). 

JPROJ=JPR0J/2 

***  REDEFINE  ACTIVE  GRID  MARKERS. 

11=11*2 


R&Z3590 
REZ3600 
REZ3610 
RE23620 
REZ3630 
REZ3640 
REZ3650 
RtZ3660 
REZ3670 
REZ3600 
REZ3690 
REZ3700 
REZ3710 
REZ3720 
REZ3730 
REZ3732 
REZ3734 
RE* '.3740 
RLZ3750 
RE23760 
REZ3770 
REZ3780 
REZ3785 
REZ3790 
REZ3800 
REZ3805 
REZ3810 
REZ3020 
REZ3825 
REZ3830 
REZ3835 
REZ3840 
REZ3850 
REZ3860 
REZ3870 
REZ3880 
REZ3890 
REZ3900 
REZ3910 
REZ3915 
REZ3920 
REZ3930 
REZ393S 
REZ3940 
REZ3950 
REZ3960 
RLZ3970 
REZ3980 
REZ3990 
REZ4000 
REZ4010 
REZ4012 
REZ4014 
REZ4020 
RLZ4030 
REZ4040 
RLZ4050 


132 


520 


C 

C 

c 


(li.ST.IMAX) 


Il-IMAX 

12=JMAX 


C 

C 


530 

C 


540 

55Q 

C 

C 

C 


5o0 

C 

C 

C 

C 


57.J 


T *'•*  vAur  am r\  AnT 
1  U  vw  . 


COUNTED  AS  A  CALCULAT IONAL 
incremented  BEFORE  PROCEEDING 


12=12+2 
IF 

IF  ( I2cGT » JMaX) 

***  Call 

cycle#  so  nc  and  t  are 

ON  TO  Pill  #  PH3  AND  PH2. 

WS=T+0TNA 

NK=NC+1 

WRITE  (5# 620)  V/S.-NK»UX(1) 

***  REDEFINE  CONSTANTS  AND  CELL  LIMITS  FOR  CALCULATING 
TENSIONS  AND  STRESSES. 

KMAX=1MAX*JMAX+1 

IMAXA=IMAX+1 

JMAXA=JMAX+l 

KMAXA=KMAX+i 

N6=N6/2 

JSTR=JSTR/2 

IF  (NUMREZ.or.NRE2)  NREZ=NU,MREZ 
NPLACE=NKEZ-NUMRc.Z+2 

***  CALCULATE  NEW  Fjl 

ETH=0» 

DO  530  K=2»KMAX 

ETH=ETH+AMX(K)*(AIX(K)+.5*(U(K)**2+V(K}**2> ) 

CONTINUE 

***DIVID£  UPM(l)  BY  2  TO  GET  NEW  PEAK  PRESSURE  CELLS 
DO  550  1=1 # I MAX 
L=2*I 

IF  (L.GT.IMAX)  GO  TO  540 

JPMU)=JPM(L)/2 

GO  TO  550 

JPMII)=0 

CONTINUE 

IF  (Y2.GT.l-l.))  GO  TO  610 

***  SCALE  EXISTING  TRACER  POINTS 

DO  560  U=1»JJ 
DO  560  I=1#II 
XP(X.J)-XP(I»J)/2. 

YP(I#J)=YPU#J)/2. 

CONTINUE 

***  REMOVE  TRACER  POINTS  FROM  EVERY  OTHER  CELL  AND  EVERY 
OTHER  ROW 

NMP-0 

M=0 

DO  570  J=1#JU»2 

M-M+ 1 

L-0 

UO  570  1=1 # II # 2 
L=L+1 

XP ( L  *  M ) =XP ( I #  0 ) 

YP(L#M)-YPU»J) 

NMP=NMP+1 

JTPb=l 


REZ4O60 

REZ4070 

REZ40n0 

REZ4082 

REZ4084 

REZ4086 

REZ4090 

REZ4100 

RLZ4110 

REZ4120 

REZ4122 

REZ4124 

RGZ4130 

RLZ4140 

REZ4150 

REZ4160 

REZ4170 

REZ4180 

REZ4190 

REZ4200 

KEZ4210 

REZ4230 

RE24240 

REZ4250 

REZ4260 

.REZ4270 

REZ4280 

REZ4290 

REZ4300 

REZ4310 

REZ4320 

REZ4330 

REZ4340 

REZ4350 

REZ4360 

REZ4370 

REZ4380 

REZ4390 

REZ4400 

REZ4410 

REZ4420 

REZ4430 

RE24440 

REZ4450 

REZ4460 

REZ4470 

RE24480 

REZ4490 

REZ4500 

REZ4510 

BEZ4520 

RF.Z4530 

REZ4540 

REZ4550 

REZ4560 

REZ4570 

REZ4580 
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r 


c 

C 

c 

.C 

c 


JTPT- 1 NT ( FLOAT < JJ ) /2  *  *  *  6 ) 

ITPL=INT (FLOAT (1 1  > /2.  +  .6) +1 

***  INITIALISE  remaining  tracer  point  storage  and 
***  PLACE  NEW  TRACER  POINTS  FIRST  IN  NEW  CELLS  ABOVE  OLD 
GRID  THEN  IN  NEW  CELLS  TO  THE  RIGHT  OF  OLD  GRID. 


580  DO  600  J=JTP6»JTPT 
DO  600  I=ITPL»II 
XP(I»J)=0«, 

YP(I»J)=0. 

K=2*< (J-1)*IMAX+I) 

IF  (AMX(ft)  .F.O.0.)  GO  TO  590 


REZ459G 

REZ4600 

REZ4610 

REZ462Q 

REZ4&30 

REZ4635 

RE24640 

REZ4650 

RE24660 

RE24670 

RE24680 

REZ4690 

REZ4700 


C 

c 

c 


590 

600 

C 

C 


610 

C 

620 


XC£LL=2*I-1  REZ4710 

0C£LL=2*J-1  REZ4720 

***  PLACE  NEW  TRACER  POINTS  IN  CELLS  SO  THEY  LINE  UP  REZ4722 

WITH  EXISTING  TRACER  POINTS  BY  USING  NPLACE  WHICH  REZ4724 

IS  A  FUNCTION  OF  THE  NUMBER  Or  REZONES  PERFORMEO.  REZ4726 

XP ( I , 0) =FLOAT ( ICELL-1 ) +1 ./2 . **NPLACE  RE24730 

Yp ( I #  J ) =FLOAT i UCELL-1 ) +1 . /2.**NPLACE  REZ4740 

NMP-NMP+1  REZ4750 

CONTINUE  REZ4760 

IF  (J.GE.JJ)  GO  TO  610  REZ4770 

***  GO  BACK  THROUGH  LOOPS  ADDING  POINTS  ON  RIGHT  SIDE  OF  REZ4772 

OLO  GR10.  REZ4774 

JTPB=JTPT+1  REZ4780 

JTPT=JJ  REZ4790 

ITPL=i  REZ4800 

GO  TO  580  REZ4810 

RETURN  REZ4820 

REZ4830 

FORMAT  (1H  ////22H  PROBLEM  REZONED  AT  T=» 1PE12.6* 6Xr 5HCYCLEI4# 6X» 6REZ4840 
1HDX(1>=*£12.6////)  REZT850 

c.ND  REZ4860- 
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c 

c 


c 

c 


c 

c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 

c 

c 

c 


SUBROUTINE  ERROR 

- 

ERR 

.  F&O 

10 

?n 

1  ERR 

30 

DIMENSION  AMX125J2) #AlX(2502>  »U(25U2> 

» v (2502) 

#M  Ar-rt/M 

friCJUC/  r 

COO 
fc-i  »i\ 

40 

1 

X ( 52 )  #  XX ( 54)  #TAU(52) 

» JPM (52) 

# 

err 

50 

2 

Y ( 102)  #  YY ( 104)  » FLEFT (102) »  YAMC(l02)#  SIGC(102)» 

ERR 

CO 

3 

GAMC(1  02)  t 

ERR 

70 

4 

PK ( 15) t  Z ( 150 )  » 

err 

80 

5 

XP(26#5l) #YP(26»5l) » 

ERR 

90 

6 

PL (204)  #UL(204)  t PR (204) 

# 

ERR 

100 

7 

RSN(b2) »  RST (52)  » 

EkR 

110 

8 

CMXP (5)  fCMYP(5)  » I J(5) 

»JK(5) 

f 

ERR 

120 

9 

DX(52)  »DDX<54)  »DY(102) 

» DDY (104) 

# 

err 

130 

S 

SNB (52)  # STB (52)  #UK(52»3) 

#VK(52#3) 

»RH0(52#3) 

ERR 

140 

***  DIMENSIONED  ARRAYS 

ERR 

150 

***  Z-BLOCK  IS  SAVED  ON  TAPE. 

ERR 

160 

COMMON 

Z 

ERR 

170 

COMMON 

PK 

ERR 

180 

COMMON 

YY#  XX 

ERR 

190 

COMMON 

DDX#  DDY 

ERR 

200 

COMMON 

AMX #  AlX#  U#  V#  P 

err 

210 

COMMON 

TAU#  JPM 

ERR 

220 

COMMON 

UL  »  PL 

•  ERR 

230 

COMMON 

XP  »  -P#  CMXP#  CMYP 

ERR 

240 

COMMON 
1AMVT 
2£ 

3LL 
4NR 
5SUM 
bnFLAGL»HFLAG? 


***  NON-OX MENS IONED 
A 10  » AMMV 

»DELEB  »DEL£R  fDELET 
# ERDUMP » I  1 13 
» MO  » ME  » MZT 

#NRZ  *NUlLE  fPIOTS 

»TESTR|;»TW0PI  tURR 


variables 

#  AMMY  » AMPY 

»DELM  »dtodx 

» I WS  # J 
»NERR  »NK 
» SIEMIN»  SNR 
»riS  »WSA 


t AMUR  » AMUT 
#DXYMIN»EAMMP 
#K  #KA 

#NPRINT# 

#SNT  iSTR 
» USB  #WSC 


»AMVR  » 

» eampy  » 

»KB  » 

» SOLID  » 
#  WFLAGF » 


***  THE  FOLLOWING  EQUIVALENCES  MAKE  AVAILABLE 

x(o)»  y(o;#  oxto),  oy;o) 

EQUIVALENCE  ( XX ( 2 )  »  X(l))»  ( YY (2) »  Y C 1) ) 

EQUIVALENCE  (DDX(2)»  0X(1})»  (DDY ( 2)  »  CY ( 1) ) 

***  SPECIAL  EQUIVALENCES  FOR  PH2  ONLY 

EQUIVALENCE 


(UL»FLEFT> # 
(PL#GAMC?PR> » 


(UI_(103)  »YAMC) » 
(PL(l03) r SIGC ) 


***  SPECIAL  EQUIVALENCES  FOR  PH3  ONLY 
EQUIVALENCE 


1 

2 
3 


(UL’RSN) i 
(PL#RST) » 
(P(l57) t VK) » 
(P(365) #STB) r 


(P#UK>  # 

CPC 313) »SNB>  » 
(P(4I7) » RHO) 


***  SPECIAL  EQUIVALENCES  FOR  EDIT 
EQUIVALENCE  (PR(l)r  10) »  (PR(6)»  JK> 

***  Z-STORAGE  EQUIVALENCES 

EQUIVALENCE  (Z (  DrPROB  )»(Z(  2)  # CYCLE  >» 


ERR  250 
ERR  260 
ERR  270 
ERR  280 
ERR  290 
ERR  300 
ERR  310 
ERR  320 
ERR  330 
ERR  340 
ERR  350 
ERR  360 
ERR  370 
ERR  380 
ERR  390 
ERR  400 
ERR  410 
ERR  420 
ERR  430 
ERR  440 
ERR  450 
ERR  460 
ERR  470 
ERR  480 
ERR  490 
ERR  500 
ERR  510 
ERR  520 
ERR  530 
ERR  540 
ERR  550 
ERR  560 
ERR  570 
ERR  580 


1T5 


o  o  o  o  o  n  o 


1(Z(  3) » QT  ) 

,  (Z( 

4) 

,  NUMSP 

)  , 

{  7  ( 

5)  * 

NFRELP)  .* 

(2( 

r*\  * 

w  ,  » 

Mnl  iMO"7  1 
iu«rn  »  / 

r 

L"J>n 

U1M\ 

cnn 

j 

2(2 (  7) , ICSTOP) 

,(z( 

8) 

»PIDY 

)  , 

(Z( 

9) 

,'topmu  ) 

,Tz( 

10) 

,  rtmu 

) , 

ERR 

600 

3(2(  11) ,STKi  ) 

,  (2( 

12) 

»NUMREZ) f 

(2( 

13) 

rETH  ) 

,  ( 2  ( 

14) 

,  UN14 

)  , 

ERR 

610 

4(2(  15) , RHINIT) 

,(2( 

16) 

,PROJI 

)  , 

(2( 

17) 

,UN17  ) 

,  ( 2  ( 

10) 

,  XMAX 

)  , 

ERR 

620 

5(Z(  19) ,NZ  ) 

,<2( 

20) 

,NR£Z 

)  , 

( 2  ( 

21) 

f  amdm  ) 

,  (Z( 

22) 

,UVMAX 

)  , 

ERR 

630 

6(2(  23) , UN23  ) 

,(Z( 

24) 

,"MlN 

)  , 

(Z( 

25) 

,JSTR  ) 

,  (Z( 

26) 

,dtna  ■ 

)  , 

ERR 

640 

7(2(  27) ,CVIS  ) 

,  (Z( 

28) 

»  STK2 

)  , 

(Z( 

29) 

t  STE2  ) 

,  (2 ( 

30) 

»nc 

)  , 

ERR 

650 

8(Z(  31 ) , UN31  ) 

, <Z( 

32) 

» i\RC 

)  , 

(Z( 

33) 

>imax  ) 

,  (Z( 

34) 

,  IMAXA 

)  , 

ERR 

660 

9(Z(  35) ,  JMAX  ) 

,(Z( 

36) 

,  jmaxa 

)  , 

(Z( 

37) 

,kmax  ) 

,  <Z( 

38) 

,KMAXA 

) 

ERR 

670 

EQUIVALENCE 

ERR 

680 

1(Z(  39) ,  BOTM  ) 

,(Z( 

40) 

, QOTMV 

)  r 

(Z( 

41) 

#NUMSPT) 

,  (Z( 

42) 

,  CZERO 

)  , 

ERR 

690 

2(Z<  43) , NUMSCA) 

,(Z( 

44) 

*  PRLIM 

)  , 

( 2  ( 

45) 

,prdelt) 

>  (Z( 

46) 

,PRFACT) 

ERR 

700 

equivalence 

Ekr 

710 

1(Z(  47) , 11  ) 

,(2< 

48) 

#12 

)  , 

( 2  ( 

49) 

» IPCYCL) 

,  (Z( 

50) 

» TSTCP 

> , 

ERR 

720 

2(Z(  51) ,RH0F1L) 

,  (2( 

52) 

#  TARGV 

)  , 

(Z( 

53) 

»N3  ) 

,  (Z( 

54) 

,  IVARDY) , 

ERR 

730 

3(Z(  55) » VT  ) 

,(Z( 

56) 

,N6 

)  , 

(Z( 

57) 

»RTM  ) 

,  (Z( 

58) 

»  rtmv 

) , 

ERR 

740 

4(Z(  59) »UN59  ) 

*  (Z( 

60) 

,  N10 

)  , 

(2  ( 

61) 

,  Nil  ) 

,  (Z( 

62) 

, GAMMA 

) , 

ERR 

750 

5(Z(  63) ,  TOPM  ) 

*(Z( 

64) 

,BOTMU 

), 

(Z( 

65) 

,SN  ) 

,  (Z( 

66 ) 

»TOPMV 

) , 

err 

760 

6(Z(  67) ,PRYdOT ) 

,(Z( 

68) 

,PRYTOP) , 

(Z( 

69) 

,PRXRT  ) 

»(Z( 

70) 

,CYCPH3) , 

ERR 

770 

7(Z(  71) f REZFCT) 

,  (2( 

72) 

* TARGI 

)  , 

(Z  ( 

73) 

,PROJU  ) 

,  (Z( 

74) 

,OBCUND) , 

ERR 

780 

8 (2 (  75)  #EVAP  ) 

,<Z( 

76) 

,ECK 

)  , 

(Z( 

77) 

,necycl) 

,(Z( 

78) 

»H 

) , 

ERR 

790 

9(Z(  79), JJ  ) 

,(  Z( 

60) 

,  NMP 

), 

(Z( 

81) 

,Y2  ) 

,(Z( 

82) 

,EZPHl 

) 

ERR 

800 

EQUIVALENCE 

ERR 

810 

1(Z(  83)  , 1 VARDX) 

r  (Z( 

64) 

,  T 

)  , 

(2  ( 

85) 

, nmpmax ) 

,(Z( 

86) 

,PMIN 

) , 

ERR 

820 

2(Z(  67), INTER  ) 

,<z( 

68) 

#TAY60T), 

(Z( 

89) 

, TAYTOP) 

,  (Z( 

90) 

,iemap 

) , 

ERR 

830 

3(Z(  91), MC  ) 

,(  Z( 

92) 

,MR 

)  , 

(Z( 

93) 

,MZ  ) 

,(Z( 

94) 

,MB 

) 

ERR 

840 

EQUIVALENCE 

ERR 

850 

1(Z(  95) ,REZ  ) 

,(z( 

96) 

#NOOUMP) , 

(Z( 

97) 

, UN97  ) 

,  (Z( 

98) 

,UN98 

) , 

ERR 

860 

2(Z(  99) , UN99  ) 

, (z(100) 

#evapm 

)  , 

(Z(101) 

rEVAPEN) 

, (Z ( 102) 

, EVAPMU) , 

EkR 

870 

3<Z(103),EVAPMV) 

, (Z(1U4) 

,EZPH2 

)  , 

(Z ( 105) 

,SNL  ) 

, (Z(106) 

,stl 

), 

ERR 

880 

4(Z(1U7) ,TaXRT  ) 

, (Z(108) 

, IDNMAP) » 

(Z ( 109) 

, IPRMAP) 

, (Z(110) 

,ROEPS 

), 

ERR 

890 

5<ZUli)  ,RHINI  ) 

,  (2(112) 

,VINI 

), 

(Z ( 113) 

, FINAL  ) 

, (Z ( 114) 

,IVMAP 

) , 

ERR 

900 

6(Z(115) ,RHOZ  ) 

,<Z(U6) 

,ESA 

), 

(Z ( 117 ) 

,ESEZ  ) 

, (Z(118) 

,ESB 

) , 

ERR 

910 

7(Z(119) rESCAPA) 

, (Z ( 120) 

,ESESP 

)  , 

(2(121) 

,ESESQ  ) 

.•  (Z  ( 122) 

,ESES 

) , 

ERR 

920 

8(Z(123) , ESALPH) 

, (Z ( 124) 

,ESBETA) , 

(Z(125) 

,ESCAP3) 

, (Z(125) 

,  IU/-1AP 

), 

ERR 

930 

9(2(127), SSI  ) 

» (Z(128) 

,  SS2 

)  , 

(2(129) 

,UMIN  ) 

, (Z(130) 

,SS4 

) 

ERR 

940 

EQUIVALENCE 

ERR 

950 

1(Z(131) ,PRTIME) 

, (Z(132) 

,EOR 

)  , 

(Z(133) 

,  EOT  ) 

, (Z( 134) 

>EOB 

) , 

ERR 

960 

2(Z(135),EM0R  ) 

, (2(136) 

»  DxF 

)  , 

(2(137) 

,DYF  ) 

, (Z(138) 

, RHOMIN)  , 

ERR 

970 

3(Z(i39) ,STA3) , 

(2(140) , 

XIENRG) 

, 

(2(141) 

,XKENRG) 

,  (Z(142) ,XTENRG) 

,  ERR 

980 

4(2(143), STT  ) 

, (Z ( 144) 

,OT<MIN 

)  , 

( Z (145) 

,TRNSFC) 

, (Z(146) 

,emot 

), 

ERR 

990 

5 (Z ( ±47) , JPROU  ) 

, (2(148) 

,cnaut 

)  , 

(Z ( 149) 

, B3AR  ) 

,  (Z( 

150) 

,  EM06 

) 

ERP1000 

ERIU010 

•EKR1020 

ERR1G30 


END  OF  COMMON  ERR1040 

ERR1050 

. . . . . . . EKR1060 

ERK1070 


IF  (NERR.EG.l)  GO  TO  120 

ERR 10 80 

GO  TO  (.10,20,50,40,50,60,70,80,90,100),  NR 

ERR1090 

10 

WRITE  (6,130)  NK 

ERRliOO 

• 

GO  TO  110 

ERR11I0 

2(J 

WRITE  (6,140)  NK 

ERR112G 

GO  TO  110 

ERR1130 

31) 

WRITE  (6,150)  NK 

ERR1140 

GO  TO  110 

ERR1150 

136 


'•RITE  (b»  160 )  NK 
GO  TO  110 
WRITE  (6/ 170)  NK 
GO  TO  110 
WHITE  (6» 180)  NK 
GO  TO  110 
WRITE  (£>?  190)  NK 
GO  TO  110 
WRITE  (6>200)  NK 
GO  TO  110 
WRITE  ( 6 • 210 )  NK 
GO  TO  110 
WRITE  (G»220)  NK 

WRITE  (6»230)  I • J, IM» Z ( M ) # Z(M) #M=1 t 150) 
***  IF  NR=1»  ERROR  IS  IN  INPUT  DECK 
IF(NR.EQ.I)  GO  TO  120 


ERRUoO 
ERR1170 
ERR11B0 
ERR1190 
ERR1200 
ERR 1210 
ERR1220 
ERR1230 
ERR1240 
ERR1250 
ERR1260 
ERR1270 
ERR1280 
ERR1290 
ERR1292 
ERR1294 


***  IF  NR-5  AND  NK=130»  EDIT  PRINT  HAS  JUST  BEEN  DONE.  BY  ERR1296 
SETTING  ERDUN'.P=lc»EDIT  V.'ILL  DO  A  TAPE  DUMP  BUT  NOT  ERR1298 


ANOTHER  PRINT. 

IF  ( NR o EU •  8 . AND « . .'K « c.o .130)  ERDUMP=1. 

NERR  =  1 

13=11 

NPRINT=1 

WFLAGL—l . 

NUMSPT=NOUMP7 

call  edit 
call  exit 


ERR1300 
ERR1310 
ERR1315 
ERR1320 
ERR133C 
ERR1340 
ERR1350 
ERR1260 
ERR1370 
ERR1380 
ERR1390 

FORMAT  U.Hl*bX>3oH^**  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  »l5rlOH  INERR1400 
1  INPUT  )  ERR1410 

format  uhi»5X»3<jh***  error  exit  -  see  statement  number  *i5»ioh  inerri420 
1  SETUP  )  ERR1430 
FORMAT  (lHl»bX»3oH***  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  »I5*10H  INERR1440 
1  CDT  )  ERR1450 
FORMAT  UHl»bX»3JH***  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  »I5»10H  INERR1460 
1  ES  )  ERR1470 
FORMAT  <1H1>5X#3oH***  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  *I5»10H  INERR1480 
1  EDIT  )  ERR1490 
FORMAT  (lHl>bX?3oH***  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  »I5»10H  INERR1500 
1  MAP  )  ERR1510 
FORMAT  (1H1'SX»3oH**«  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  »I5>10H  INERR1520 
1  PHI  )  ERR1530 
FORMAT  (1H1»5X>3oH***  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  *I5»10H  INERR1540 
1  PH3  )  ERR1550 
FORMAT  (lHl»bX»3oH***  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  *I5»10H  INERR1560 
1  PH2  )  ERR1570 
FORMAT  CiHl»bXr38H***  ERROR  EXIT  -  SEt  STATEMENT  NUMBER  »I5»10H  INERR1580 
1  REZONE)  ERR1590 
FORMAT  C//5Xr6H  I=iI3»6H  J=I3»6H  K=I3//16X»7HZ~BL0CK//6Xr ERR1600 
115H  REAL  FORMAT  »5X»15H  INTEGER  F0RKAT/2X? 1HI » 8X» 4HZ ( I )» 17X»4HZ (ERR1610 
2I)//(I4»2X»E15o6»5X»I15) )  ERR1620 
ENO  ERR1630 
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7.  DICTIONARY 


This  section  includes  a  description  of  the  use  and  location  of  each  of 
the  variables  in  the  program.  The  following  terminology  is  used  in  the 
dictionary: 

"Local"  Means  name  is  local  to  subroutine  (not  in  Blank  Common). 

(c) 

"Localv  Means  name  is  in  Blank  Common  (or  equivalenced  to  a  vari¬ 

able  in  Blank  Common),  but  its  value  is  never  passed  to 
another  subroutine. 

"Global"  Means  name  is  in  Blank  Common  (or  equivalenced  to  a 

variable  in  Blank  Common)  and  its  value  is  passed  from 
one  routine  to  another. 

=  Z(N)  Means  variable  is  equivalenced  to  a  member  of  the  Z- 

array,  the  first  array  in  Blank  Common.  These  vari¬ 
ables  are  usually  used  in  setting  up  and  restarting. 


ADDVL 

Local 

Used  in  SETUP.  Used  in  finding  volume  of  cells  con¬ 
taining  sphere-boundary. 

AID 

Local^ 

Used  in  EDIT  in  calculation  of  crater  depth. 

AIX 

Global 

Specific  interral  energy  in  a  cell.  (IM4X  by  JMAX 
array. ) 

ALE 

Constants 

Used  in  MAP.  This  array  has  alphabetic  characters 

for  pressure,  density,  velocity,  and  energy  maps. 
(Defined  in  DATA  statement.) 

AMDM 

=  Z(21). 

INPUT  parameter.  A  cell  with  compression  >  AMDM  is 

considered  solid. 

Usual  value:  0.95  bo  0.99* 

Used  in  BS  in  testing  whether  to  allow  negative  pres¬ 
sures  (tensions). 

Used  in  INPUT  to  calculate  SOLID  =  AMDM  *  RKOZ,  which 
is  used  in  CUT  and  FH3* 

AMMP  Local  Used  in  FH2.  Mass  moving  across  right  boundary  of  a 

cell.  (See  Appendix  B) 
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AI-1MU 

Local 

Used  in  PH2.  Radial  momentum  transported  across  the 
bottom  boundary  of  a  cell.  (See  Appendix  B) 

AMMV 

Local ^ 

Used  in  PII2.  Axial  momentum  transported  across  the 

bottom  boundary  of  a  cell.  (See  Appendix  B) 

Aim 

Local^ 

Used  in  PH2.  Amount  of  mass  moving  across  bottom 
of  a  cell.  (See  Appendix  B) 

AMPY 

Local^0^ 

Used  in  PH2.  Amount  of  mass  moving  across  top  of  a 
cell.  (See  Appendix  B) 

AMUR 

Local^C^ 

Used  in  PH2.  Radial  momentum  transported  across 

right  boundary  of  a  cell.  (See  Appendix  B) 

AMUT 

Local 

Used  in  PH2.  Radial  momentum  transported  across 

top  boundary  of  cell.  (See  Appendix  B) 

AKVR 

Local^C^ 

Used  in  PH2.  Axial  momentum  transported  across  right 
boundary  of  a  cell.  (See  Appendix  B) 

AMVT 

Local<C) 

Used  in  PH2.  Axial  momentum  transported  across  top 
boundary  of  a  cell.  (See  Appendix  B) 

A  MX 

Global 

Mass  in  a  cell.  (1MAX  by  JMAX  array.) 

ARSAFC 

Local^C^ 

Used  in  SETUP.  Area  of  a  cell- face.  Used  in  setting 

up  a  sphere.  Equivalenced  to  DSLEB. 

B 

Local 

Used  and  calculated  in  PH3 

BEAR 

=  Z(l49) 

Used  in  CDT.  An  INPUT  parameter  used  in  local  sound- 

speed  calculation  whose  value  depends  on  the  kind  of 
material.  (Local  sound-:>peed  is  approximated  as 


cQ  +  (bear)  •  /p[k)  • ) 

BEOUND 

=  Z(74) 

Calculated  in  PH3*  Printed  in  EDIT  under  "Plastic- 

Work."  Total  work  done  by  the  plastic  stresses. 

BOTM 

=  z(39) 

Calculated  in  PH2.  Printed  in  EDIT. 

out  bottom  of  grid. 

Total  mass  lost 

BOTMU 

=  Z(64) 

Calculated  in  PH2.  Printed  in  EDIT. 

momentum  lost  out  bottom  of  grid. 

Total  radial- 
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BOTMV 

o 

-3- 

Csl 

n 

CMXP 

Local^ 

CMYP 

Local^C/ 

CNAUT 

a 

IS 

•— 

00 

CRAD 

Local^ 

CVIS 

'»  Z(2T) 

CYCU2 

*  Z(2) 

CYCPH3 

=  Z(70) 

CZERO 

=  Z(42) 

DDX 

Global 

DDY 

Global 

DELEB 

Local^ 

DELER 

(Local^ 

DELET 

Local^0' 

Calculated  in  PH2.  Printed  in  EDIT.  Total  axial- 
momentum  lost  out  bottom  of  grid. 

Used  .and  calculated  in  EDIT  for  printing  the  centimeter 
coordinates  of  the  tracer  points. 

Used  in  COT,  INPUT.  Approximate  sound-speed  of 
material j  calculated  in  INPUT  as 

n  ~  /  ESCAPA*  _  rrrz 
C0  /  RHOZ  “  A'P  * 

Used  in  EDIT  for  printing  radii  of  crater  depths. 
Equivalenced  to  UL  array. 

INPUT  parameter.  Used  to  describe  the  bottom 

boundary- condition.  Used  in  PHI,  PH2,  PH3* 

Bottom  boundary  is  transmittive  when  CVIS  =  -1., 

reflective  when  CVIS  =  0. 

Used  in  INPUT,  SETUP,  COT,  EDIT.  Cycle  number  (an 
integer  value  in  floating  point  form). 

Used  in  MAIN  and  PH3.  INPUT  parameter:  Number  of 
times  to  si* cycle  PH3»  If  value  is  -1.,  PH3  is 
omitted. 

INPUT  parameter.  Value  of  Yq  for  yield  strength 
calculation.  Used  in  PH3.  (See  STRENG) 

An  array  equivalenced  to  the  DX  array  such  that 
DDX(l)  =  DX(0), 

An  array  equivalenced  to  the  DY  array  such  that  DDY(l) 

=  DY(0). 

Used  in  PU2.  Total  energy  associated  with  mass  trans¬ 
ported  across  bottom  boundary  of  a  cell.  (See 
Appendix  B) 

Used  in  PH2.  Total  energy  associated  with  mass  trans¬ 
ported  across  riggit  boundary  of  a  cell.  (See  Appendix  B) 

Used  in  PH2,  Total  energy  associated  with  mass  trans¬ 
ported  across  top  boundary  of  a  cell.  (See  Appendix  B) 


DELI 


DEIM 

DELU 

DELV 

DMIN 

DSCALE 

m 

DTFACT 

DTMIN 

ETNA 

DTNOW 

DTODX 

DTODY 

DTSTR 

DUODX 

DUODY 

DVODX 


Local 


Local 


Local 


Local 


(C) 


»  Z(24) 


Local 

=  z(3) 

Local 

=  Z(lkh) 
=  Z(26) 


Local 


Local 

Local 

Local 

Local 

Local 

Local 


(C) 


Used  in  ?H2,  PR3«  Change  of  specific  internal  energy 
of  a  ceil. 

Used  in  PH2  for  total  mass  moving  into  or  out  of  a 
cell# 

Used  in  PH2,  PH3*  Change  of  radial  velocity  of  a 
cell. 

Used  in  PH2,  PH 3*  Change  of  axial  velocity  of  a 
cell. 


INPUT  parameter.  Allowable  relative  error  in  energy 
sum.  If  error  is  >  DMIN  then  calculation  is  termin¬ 
ated.  Used  in  EDIT.  If  everything  is  working  right 
you  should  be  able  to  use  10"  ^  for  p^IN. 

Used  in  MAP  as  linear  scale  factor  for  compression 
map. 

Time  step.  Calculated  in  CDT.  Used  in  SETUP,  EDIT, 
PHI,  PH2  and  PH3» 

Used  in  PH3  in  calculating  a  variable  time  step  when 
subcycling  the  PH3  calculations. 

INPUT  parameter.  Used  in  CDT.  After  STAB  =  FINAL, 
if  DT  <  DTMIN  execution  is  stopped. 


DT  from  previous  time  cycle.  Used  in  INPUT,  CDT, 
EDIT,  REZONE  and  PHI. 

Used  in  EDIT.  Used  for  saving  DT  when  calling  CUT 
to  recalculate  pressures  after  a  REZONE. 

Used  in  PH2  for  ET/DX. 

Used  in  PH2  for  DT/DY. 

Used  in  PH3*  DT  for  recycling  through  PH3* 


Used  in  PH3*  DU/DX. 
Used  in  PII3»  DU/DY. 
Used  in  PH3-  DV/DX 

l4l 


DVODY 


Local 


Used  in  PII3.  DV/DY 


DX 

Global 

DXF 

=  Z(136) 

DXSUM 

Local 

DXYMIN 

Local ^ 

DY 

Global 

DYF 

-  Z(137) 

DYSUM 

Local 

E 

Local^ 

EAMMP 

Local^C  ^ 

EAMPY 

Local ^ 

ECK 

-  z(76) 

EMOB 

=  Z(150) 

EMOR 

=  Z(135) 

EMOT 

=  Z(l46) 

ENERGY 

Local 

The  radial  dimension  of  cells.  Equivalenced  to  DDX 
such  that  DDX(l)  =  DX(O). 

An  INPUT  parameter  vised  to  calculate  the  DX  array  if 
the  radial  dimension  of  the  cells  is  uniform. 

Used  in  SETUP  and  REZONE  to  find  cell  dimensions  of 
packages  when  DX  is  not  constant. 

Used  in  CET.  Minimum  (DX,  DY)  of  a  cell.  Used  in 
calculation  of  SRATIO  and  DT. 

The  axial-dimension  of  cells.  Equivalenced  to  DDY 
so  that  DDY(l)  =  DY(o). 

INPUT  parameter.  DY  of  all  cells,  if  DY  is  constant. 

Used  in  SETUP  and  REZONE  to  find  cell  dimensions  of 
packages  when  DY  is  not  constant. 

Used  in  REZCNE,  PHI,  and  PH3*  Temporary  storage  for 
energy  calculations. 

Used  in  PH2.  Specific  internal  energy  of  mass 
moving  across  right  edge  of  cell. 

Used  in  PH2.  Specific  internal  energy  of  mass 
moving  across  top  of  cell. 

Used  in  EDIT.  Relative  error  in  energy  sum.  If 
|  ECKj  >  DMIN,  execution  is  stopped. 

Calculated  in  PH2.  Printed  in  EDIT.  Energy  change 
out  of  bottom  of  mesh. 

_ Calculated  in  PH2.  Printed  in  EDIT.  Energy  change 
out  right  side  of  mesh. 

Calculated  in  PH2.  Printed  in  EDIT.  Energy  change 
out  of  top  of  mesh. 

Used  in  PH2  to  sum  energy  of  cells. 

Used  in  PH2  as  temporary  storage  for  energy  of  a  cell. 

ite 


ENGY 


Local 


EOB 

=  Z(134) 

Calculated  in  PHI.  Printed  in  EDIT.  Energy  change 

due  to  work  done  at  bottom  boundary. 

EOR 

=  Z(132) 

Calculated  in  Pill.  Printed  in- EDIT.  Energy  change 

due  to  work  done  at  right  boundary. 

EOT 

«  Z(133) 

Calculated  in  PHI.  Printed  in  EDIT.  Energy  change 

due  to  work  done  at  top  boundary. 

ERDUMP 

Local 

Used  in  EDIT  and  ERROR.  Flags  EDIT  to  stop  execution 

because  ERROR  has  been  called. 

ESA 

=  Z(ll6) 

INPUT  parameter.  Value  of  "a"  in  equation  of  state. 
Used  in  ES.  (=  y  -  1  when  using  perfect  gas  equation 
of  state.) 

ESALPH 

=  Z(123) 

INPUT  parameter.  Value  of  "or"  in  equation  of  state. 

Used  in  ES. 

ESB 

=  Z(ll8) 

INPUT  parameter.  Value  of  "b"  in  equation  of  state. 

Used  in  ES. 

ESBETA 

=  Z(124) 

INPUT  parameter.  Value  of  "S"  in  equation  of  state. 

Used  in  ES. 

ESCAPA 

=  Z(119) 

INPUT  parameter.  Value  of  "A"  in  equation  of  state. 

Used  in  ES. 

ESCAPB 

=  Z(125) 

INPUT  parameter.  Value  of  "B"  in  equation  of  state. 

Used  in  ES. 

SSCLE 

Local 

Used  in  MAP  as  a  logrithmic  scale  factor  for  energy 

map. 

ESES 

=  Z(122) 

INPUT  parameter.  Value  of  ES  in  equation  of  state. 

Used  in  ES. 

ESESP 

=  Z(l20) 

INPUT  parameter.  Value  of  ES'  in  equation  of  state. 

Used  in  ES. 

ESESQ 

il 

ro 

INPUT  parameter.  ESESQ  is  usually  equal  to  ESESP. 

It  is  used  to  test  whether  a  cell  should  be  con- 

sidered  hot  or  cold  in  free- surface  trer-.tir.ont.  Used 
in  CUT  and  PH2. 
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ESEZ 


in  equation  of  state 


=  Z(117)  INPUT  parameter.  Value  of  "E  " 

o 

Used  in  ES. 

ESUM  Local  Used  in  EDIT  to  sum  energy  and  calculate  relative 

error  of  energy  sum. 

ETA  Local  Used  and  calc  elated  in  ES.  =  p/pQ. 

ETH  ~  7:  (13 )  Theoretical  value  of  total  energy  in  the  mesh.  Used 

in  SETUP,  EDIT,  REZONE,  PHI,  PH2,  PH3.  Calculated  in 
SETUP  initially;  in  PH2  thereafter.  It  is  redefined 
in  REZONE • 

EVAP  =  Z(75 )  INPUT  parameter.  Used  in  PH2,  Any  cell  with  density 

less  than  EVAP  times  initial  density  of  "projectile" 
is  "evaporated"  and  its  energy  subtracted  from  theo- 

*3  -A 

retical  energy  of  system.  (10"3  to  10"°  are 
appropriate  values . ) 

EVAPEN  =  Z(101)  Calculated  in  F?2  and  CDT.  Printed  in  EDIT.  Sum  of 

energy  lost  through  "evaporation"  described  under 
EVAP.  Adjusted  in  CDT  when  "evaporating"  energy  of 
isolated  cells.  Initialized  in  SETUP.  Equivalenced 
to  SIESPH  in  SETUP. 

EVAPM  =  Z(100)  Calculated  in  PH2.  Printed  in  EDIT.  Sum  of  mass 

lost  through  ''evaporation"  described  under  EVAP. 

Used  in  PH2  and  COT  when  "evaporating"  mass  of  iso¬ 
lated  cells.  Initialized  in  SETUP.  Equivalenced  to 
RHOSPrI  in  SETUP. 

EVAPMIJ  =  Z(i02)  Calculated  in  PH2.  Printed  in  EDIT.  Sum  of  radial 

momenta  lost  through  "evaporation. "  Used  in  PH2  and 
COT  when  "ev;  orating"  momentum  of  isolated  cells. 
Initialized  in  SETUP.  Equivalenced  to  VINSPH  in 
•  SETUP. 

EVAPMV  =  Z(103)  Calculated  in  PH2.  Sum  of  axial  momenta  lost  through 

"evaporation".  Printed  in  EDIT.  Used  in  PH2  and  COT 
when  "evaporating"  momentum  of  isolated  cells.  In¬ 
itialized  in  SETUP.  Equivalenced  to  RHOOUT  in  SETUP. 


E2PII1 


=  Z(82) 
EZPH2  =  z(lO>0 

FINAL  =  Z(113) 

FLEFT  Local 

FLOTMA  Local 

FRX  Local 

FRY  Local 

GAMC  Local ^ 

GAMMA  =  Z(62) 

HOOP  Local 

I  Local  ^ 

IAID  Local 

ICELL  Local 

ICP3  Local 

ICSTOP  »  Z(7) 


Energy  gained  through  setting  negative  internal 
energies  to  zero  in  PHI.  Printed  in  EDIT. 

Calculated  in  PH2.  Sum  of  specific  internal  energy 
fluxes  less  than  SIEMIN  and  negative  internal  energies 
set  to  zero.  Printed  in  EDIT. 

INPUT  parameter.  Maximum  value  of  stability  fraction 
(STAB).  If  FINAL  =  0;  the  stability  fraction  will  be 
constant.  Used  in  COT. 

Used  in  PH2.  Radial  momentum  of  mass  moving  across 
left  side  of  cell.  Squivalenced  to  UL  array.  (See 
Appendix  B) 

Used  in  MAP. 

Used  in  PK2  for  moving  tracer-points. 

Used  in  PH2  for  moving  tracer- points. 

Used  i..  FH2.  Mass  moving  across  left  side  of  cell. 
Equivaleneed  to  PL  and  PR  arrays.  (See  Appendix  B) 

Calculated  value  of  GAM-IA  =  ESA  +1.  Calculated  in 
INPUT.  Used  in  COT. 

Used  in  PH3»  Hoop  stress. 

Used  in  most  subroutines  as  index  in  radial  direction. 
Used  in  EDIT  in  crater  depth  calculation. 

Used  in  REZCNE  when  placing  tracer  points  in  new  cells. 
Used  in  PH3 :  =  INT(CYCPH3). 

INPUT  parameter.  Used  ir  EDIT.  Execution  stops  on 
ICSTOP  cycle  when  stopping  on  cycles  rather  than  time. 

Used  in  MAP.  Number  of  columns  in  maps.  On  cycle 
0,  IDL  =  IMAXj  otherwise  IDL  =  II. 


IDL 


Local 


4? 

.  X 


_  FT  » 


IDNMAP 

=  Z(103) 

IEKAP 

=  z(90) 

Defined  in  INPUT.  Used  in  MAP  to  specify  the  number 

IPRMAP 

=  Z(1C9) 

’  of  symbols  to  be  used  in  the  density,  energy,  pres¬ 

IUMAP 

=  Z(li6) 

sure,  u-velocity,  and  v-veiocity  naps,  respectively. 

IVMAP 

=  z(nh)j 

II 

=  Z(78) 

Used  in  REZONE,  EDIT,  and  SETUP.  The  number  of 

*  Ac) 

local' 

tracer  points  in  each  row . 

IJ 

Used  in  EDIT.  Used  to  identify  which  column  a  tracer 

point  originated  in.  Equivalenced  to  PR(l)  in  EDIT. 

IK 

Local 

Used  in  FH3  as  index,  =1+1. 

IKK 

Local 

Used  in  PH3,  -  IK  +  1. 

ILIM1 

Local 

Used  in  MAP  as  index  for  printing  values  of  symbols. 

ILIM2 

Local 

See  ILIM1. 

IMAX 

=  z(33) 

INPUT  parameter.  Number  of  columns  in  mesh.  IMAX 

must  be  an  even  number  if  grid  is  to  be  rezoned  with 

the  exception  that  IMAX  =  1  for  a  1-D  problem.  Used 

in  SETUP,  COT,  REZONE,  EDIT,  PHI,  PH2,  and  PH3* 

IMAXA 

=  Z(3}0 

IMAX  +1.  Used  in  SETUP  and  REZONE. 

INTER 

=  Z(8?) 

INPUT  parameter.  If  UTTER  /  0,  EDIT  will  print  after 

COT,  PHI  and  PH3.  If  INTER  =  99,  in  addition  to  extia 
EDIT  prints,  stresses  are  printed  in  PH3.  (LOTS  of 
printing. )  If  INTER  =  7,  energy  totals  are  printed 
in  FH2  in  addition  to  the  extra  EDIT  prints.  Used 
in  MAIN,  EDIT,  PHI  and  Ph2  and  PH3- 

INTMA  Local  Used  in  MAP, 

IP  Local  Used  in  EDIT,  The  column  a  tracer  point  is  in. 

IPCYCL  =  Z(l+9)  INPUT  parameter.  Used  in  EDIT.  The  number  of 

cycles  between  EDIT  prints  when  printing  on  cycles 
rather  than  time. 

IPRT  Local  Used  in  REZONE.  Number  of  columns  in  projectile 

after  rezoning. 
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-  Ll 

ISPHMX 

ITPL 

ITR? 

IVARDX 

IVARDY 

IWS 

IX 

IY 

II 


12 

13 

J 


Local 


Local 

Local 


(C) 


-  2.(83) 


-  z(5;0 


Local 


(C) 


Local 

Local 

=  Z(47) 


=  Z(48) 


C<c> 
Local ^ 


Local 

,  (c) 

ir'r*  1  ' 


Used  in  SETUP.  I-index  of  right-most  column  which  . 
contains  sphere  material. 

Used  in  RKZONE  for  adding  tracer- points  in  added  cells. 

Used  in  RSZONE .  Umber  of  columns  in  target  after 
rezoningf 

Used  in  SETUP.  Flag  for  variable  radial  dimension 
of  cells. 

Used  in  SETUP.  Flag  for  variable  axial  dimension 
of  cells. 

Used  as  local  index  in  INPUT,  SETUP,  GOT,  EDIT, 

PH2  and  PH 3. 

Used  as  index  in  PH2  for  tracer-point  movement. 

Used  as  index  in  PH.2  for  tracer- point  movement. 

INPUT  par-meter.  II  is  used  to  limit  calculation 
in  radial  direction  to  "active  mesh."  Beyond  II 
nothing  is  yet  disturbed  from  initial  conditions.  II 
is  specified  initially  as  (2  +  the  column- number  of 
the  last  column  in  which  there  is  a  non-zero  velocity 
or  internal  energy).  However,  II  is  never  larger 
than  IMAX.  II  is  increased  automatically  as  inactive 
cells  beome  active.  If  IMAX  =  1,  then  II  -  1.  Used 
in  COT,  EDIT,  RSZONE,  PHI,  FH2  and  PH3* 

INPUT  parameter.  Like  II  but  for  axial-disturbance- 
limit.  12  is  specified  initially  as  (2  +  the  number 
of  the  upper- most  row  in  which  there  is  a  non- zero 
velocity  or  internal  energy).  12  is  increased  auto¬ 
matically  as  inactive  cells  become  active.  However, 

12  is  never  larger  than  JMAX .  Used  in  SETUP,  COT, 

EDIT,  REZONE,  PHI,  FH2,  PK3* 

Used  in  EDIT  as  a  flag  for  "short"  or  "long"  prints. 
Used  a?  row- index  in  most  subroutines. 
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JA 

Local 

Used  in  SETUP  to  calculate  J- index  of  top  of  sphere. 

JB 

Local 

Used  in  SETUP  to  calculate  J- index  of  bottom  of  sphere. 

JCELL 

Local 

Used  in  REZONE  when  placing  tracer  points  in  added 

cells. 

JCENTR 

Local 

Used  in  SETUP.  J- index  of  row  Just  below  center  of 

sphere. 

JDL 

Local 

Used  in  MAP.  Number  of  rows  in  maps.  On  cycle  0 , 

JDL  =  JMAX;  otherwise,  JDL  =  12. 

JFILA 

Local 

Used  in  REZONE.  The  J- index  of  the  row  immediately 
below  the  target. 

JFILB 

Local 

Used  in  REZONE.  The  J- index  of  the  row  immediately 

above  the  projectile. 

JFIAG 

Local 

Used  in  PH3*  Used  in  connection  with  JIM  for  deciding 

where  to  stop  calculating  stresses. 

JINTL 

Local 

Used  in  COT  in  defining  JPM  array. 

JJ 

=  z(79) 

Used  in  REZONE,  EDIT  and  SETUP.  Number  of  tracer 

points  in  each  column. 

J1C 

Local^C^ 

Used  in  EDIT.  Used  to  identify  which  row  a  tracer 
point  originated  in.  Equivaienced  to  PR(6). 

JMAX 

=  Z'35) 

INPUT  parameter.  Number  of  rows  in  mesh.  JMAX  must 

be  an  even  number  if  grid  is  to  be  rezoned.  Used  in 

SETUP,  COT,  EDIT,  REZONE,  PHI,  PH2,  PH3» 

JMAXA 

=  Z(36) 

JMAX  +  1.  Used  in  SETUP  and  REZONE. 

JMP1 

Local 

Used  in  REZONE.  Limit  on  do- loop,  =  JMAX/2  +  1. 

JP 

Local 

Used  as  an  index  in  COT.  Used  in  EDIT,  The  row  a 

tracer  point  is  in. 

JPA 

Local 

Used  in  REZONE.  The  J-index  of  the  top  row  of 

projectile. 

JPB 

Local 

Used  in  REZONE.  The  J-index  of  the  bottom  row  of 

projectile. 
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JFM  Global 

JPROJ  =  Z(l47) 


JRADA  Local 

JRADB  Local 

JSPHBT  Local 

JSPHTP  Local 

JSTR  =  Z(25) 


JTA 

Local 

JTB 

Local 

JTPB 

Local 

JTPT 

Local 

K 

Local ^ 

KA 

Local ^ 

KB 

Local ^ 

Calculated  in  CDT;  used  in  PH3.  Initialized,  adjusted 
and  saved  on  tape  in  SETUP,  INPUT,  EDIT  and  REZONE. 
JPM(l)  is  J- index  of  cell  with  local  maximum  pressure 
in  column  I. 

INPUT  parameter.  Usually  the  J- index  of  top  cell  in 
projectile.  Used  in  SETUP  and  EDIT.  Adjusted  in 
REZONE.  The  zero  point  in  the  crater  depth  calcul¬ 
ation.  A  division  for  printout  of  total  energies, 
mass  and  momenta. 

Used  in  SETUP.  The  J-index  of  the  top  cell  on  the 
axis  containing  a  pnrt  of  the  sphere. 

Used  in  SETUP.  The  J-index  of  the  bottom  cell  on  the 
axis  containing  a  part  of  the  sphere. 

Used  in  SETUP  as  index  in  placing  sphere. 

Used  in  SETUP  as  index  in  placing  sphere. 

INPUT  parameter.  When  active-grid  gets  to  JSTR  in  J 
direction,  stress  calculations  begin  and  negative 
pressures  are  permitted.  JSTR  needs  to  be  large 
enough  so  that  a  shock  can  become  veil  established 
before  stress  calculations  begin  and  negative  pres¬ 
sures  are  allowed.  Otherwise,  meaningless  perturb¬ 
ations  are  calculated  in  material  which  is  still  at 
rest.  Used  in  PH3>  CDT  and  REZONE. 

Used  in  REZONE  as  index. 

Used  in  REZONE  as  index. 

Used  in  REZONE.  Index  for  "weeding  out"  and  adding 
tracer  points. 

Used  in  REZONE.  Sec  JTPB. 

Used  as  cell-index  in  all  subroutines. 

Used  as  index  in  CUT  and  PH2. 

Used  as  index  in  CDT. 
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KK 

Local 

Used  as  index  in  EDIT  to  remove  tracer  points  from 

empty  cells . 

KMAX 

=  Z(37) 

Calculated  in  SETUP  (lMAX*JMAX+l).  Used  in  PH3, 

SETUP,  EDIT,  REZONE.  Largest  value  of  K  (cell-index). 

KMAXA 

=  Z(38) 

Calculated  in  SETUP  (KMAX+l).  Used  in  INPUT,  SETUP, 

EDIT  and  REZONE. 

KSPACE 

Local 

Used  in  EDIT  for  spacing  printed  output. 

L 

Local 

Used  as  index  in  EDIT,  INPUT,  PH2,  PH3,  REZONE. 

LA 

Local 

Used  as  index  in  PH2. 

LB 

Local 

Used  as  index  in  PH2. 

LJD 

Local 

Used  as  index  in  PH2  and  PH3. 

LL 

Local^0^ 

Used  as  index  in  PHI,  PII2  and  PH3. 

LOCA 

Local 

Used  in  EDIT  and  PH3  in  assigned  GO  TO  statements. 

LOCB 

Local 

Used  in  EDIT  in  assigned  GO  TO  statements. 

M 

Local 

Used  as  index  in  SETUP,  EDIT,  PH2,  REZONE,  PH3, 

ERROR. 

MA 

Local 

Used  in  MAP  to  specify  symbol  to  be  printed  for 

each  cell. 

MASS 

Local 

Used  in  PH2  for  temporary  storage  of  the  mass  of 

a  cell. 

MAXEX? 

Local 

Used  in  15AP  to  define  logarithmic  scale  factor  for 

each  map. 

MB 

-  2(9*0 

Used  and  calculated  in  SETUP.  The  J- index  of  the 

bottom  row  of  projectile. 

MC 

-  Z(9l) 

Used  and  calculated  in  SETUP.  The  J- index  of  the  top 

row  of  projectile. 

MD 

Local 

Used  in  SETUP.  Flag  indicating  whether  or  not  there 

is  a  target. 
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ME 

Local ^ 

Used  and  calculated  in  SETUP.  The  number  of  columns 

in  the  target,  (if  target  extends  beyond  mesh,  ME  = 
IMAX. ) 

MINEXP 

Local 

Used  in  MAP  to  define  logarithmic  scale  factor  for 

each  map. 

MR 

-  2(92) 

Used  and  calculated  in  SETUP.  The  number  of  columns 

in  the  projectile. 

MS LAVE 

Local 

Used  in  PH2  as  storage  for  slaved- cell  index  when 

transporting  mass  across  top  edge  of  ce3.1. 

MZ 

=  2.(93 ) 

Used  and  calculated  in  SETUP.  The  J- index  of  the 

bottom  row  of  the  target. 

MZT 

Global 

Defined  in  INPUT  (MZT  =  150).  Used  in  SETUP  and  EDIT. 

The  number  of  Z-block  words. 

N 

Local 

Used  as  an  index  in  PH3,  PHI,  FH2,  REZONE  and  EDIT. 

In  SETUP,  N  is  the  J- index  of  the  top  row  of  the 

target. 

N3 

-  Z(53) 

Defined  in  SETUP.  Used  in  SETUP,  EDIT,  INPUT  in 

reading  and  writing  tapes.  =  0  if  there  are  no 

tracer  points;  =  1  if  tracer  points  are  used. 

N6 

=  z(56) 

INPUT  parameter.  Used  in  ES.  Negative  pressures  are 

allowed  in  cells  above  J  =  N6  after  active- J  reaches 
JSTR  value.  The  value  of  N6  is  reset  in  RE ZONE. 
n6  =  0  allows  negative  pressures  everywhere.  On  the 
other  hand,  to  cake  sure  that  negative  pressures  are 
always  set  to  zero  give  Il6  a  very  large  value  (many 
times  as  large  as  JMAX )  since  in  REZONE  N6  is  cut  in 
half  in  order  to  keep  it  at  the  same  distance  (in  cm. ) 
from  the  bottom  of  the  grid. 

N10  Global  Used  in  CD!  to  identify  I- index  of  cell  which  controls 

DT. 

Nil  Global  Used  in  CDT  to  identify  J- index  of  cell  which  controls 

DT. 
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NC  =  Z(30)  Cycle  number.  Set  initially  to  -1  in  INPUT.  In¬ 

cremented  thereafter  in  COT. 

NDUMP7  =  Z (6)  INPUT  parameter.  Used  in  EDIT  to  control  frequency 

of  tape  dumps.  A  tape  dump  will  occur  every  ( NDUMP7 ) 
EDIT  prints. 

NECYCL  =  Z(77)  Defined  and  printed  in  EDIT.  The  cycle  number  associ¬ 

ated  with  the  largest  relative  error  in  the  energy 
sum. 

NERR  Global  Used  in  ERROR  ar  exit  flag.  Prevents  ERROR  from 

being  called  more  than  once  during  a  single  run. 

NFRELP  =  Z( 5 )  INPUT  parameter.  Used  in  EDIT  to  control  frequency  of 

"long”  prints.  A  "long"  print  will  occur  every 
(NFRELP)  "short”  prints. 

NIMAX  Local  Used  in  REZONE  as  storage  for  lMAX/2  when  IMAX  >  1. 

NIMAX  =  1  when  IMAX  =  1. 

NIMAX1  Local  Used  in  REZONE  as  storage  for  NIMAX  +  1. 

NJMAX  Local  Used  in  REZONE  as  storage  for  JMAX/2. 

NJMAX1  Local  Used  in  REZGNE  as  storage  for  NJMAX  +  1. 

NK  Global  Used  in  PH2,  PH3,  EDIT,  INPUT,  CDT,  REZONE  and 

ERROR.  Tells  which  statement  of  a  subroutine  caused 
ERROR  to  be  called. 

NKA  Local  Used  in  PH3  as  index. 

NKB  Local  Used  in  PH3  as  index. 

NMP  =  Z(80)  Number  of  tracer  points  in  use.  Used  in  INPUT,  .SETUP, 

REZONE,  EDIT  and  PH2.  Initially  calculated  3 i  SETUF; 
recalculated  in  REZONE. 

NMEMAX'  =  Z(85 )  INPUT  parameter.  Maximum  number  of  tracer  points  to 

be  generated.  If  fewer  points  are  needed,  NMP  will 
have  the  number  actually  generated.  NMFMAX  must  not  be 
larger  than  the  number  allowed  in  dimensions  of  XP 
and  YP.  Used  in  SETUP  and  REZONE. 
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NN  .Local 


NODUMP 

=  z(96) 

NPLACE 

Local 

NPRINT 

Global 

NR 

Global 

NRC 

NREZ 

=  Z(32) 

=  Z(20) 

NRT 

NRZ 

Local 

Global 

NSLAVE 

Local 

NULLE 

NUMREZ 

Global 

=  Z(12) 

Used  as  index  in  PH3  and  PH2. 

INPUT  parameter.  Used  in  EDIT.  When  IIODUMP  =  1,  no 
tape  dumps  are  made  except  on  cycle  0.  Allows  user 
to  restart  a  problem  without  writing  on  the  restart 
tape. 

Used  in  REZONE  for  lining  up  added  tracer  points 
with  original  ones. 

Used  in  MAIN,  CDT  and  EDIT.  Prevents  DT  and  PRTIME 
from  being  altered  on  intermediate  prints.  Also, 
NPRINT  =  1  flags  EDIT  to  print  and  check  energy 
discrepancy. 

Used  in  PH2,  EDIT,  SETUP  and  CDT  to  identify  which 
subroutine  called  ERROR.  Used  in  ERROR  for  printing 
error  message. 

Used  in  PHI  and  PH2  in  advancing  active  grid. 

Defined  in  SETUP.  Equals  maximum  number  of  rezones 
allowed.  Used  in  REZONE  to  line  up  new  tracer  points 
with  those  already  in  grid.  Used  in  EDIT  to  deter¬ 
mine  the  original  I  and  J  of  each  tracer  point. 

Used  in  PHI  and  PII2  in  advancing  active  grid. 

Initialized  in  SETUP.  Equals  number  of  rezones  so 
far  performed.  Used  in  EDIT  for  printout  of  1-D 
problems  and  for  determining  the  original  I  and  J  of 
each  tracer  point. 

Used  in  PH2  as  storage  for  slaved- cell  index  when 
transporting  mass  across  right  edge  of  cell. 

Equivalenced  to  RHCW  in  CDT  and  ES. 

INPUT  parameter.  Initially  equals  number  of  rc-zones 
allowed  in  one  run.  Diminished  by  one  after  each 
rezone.  Used  in  EDIT  and  REZONE. 


153 


NIMSCA 

»  2(43) 

INPUT  parameter.  Number  of  times  the  print  interval 

is  to  be  rescaled.  Used  in  EDIT.  See  PRDELT  for 

further  details. 

NUMSP 

=  z(4) 

Used  in  EDIT  to  count  the  number  of  "short"  prints  ' 
‘since  the  last  "long"  print. 

NUMSPf 

=  Z(4l) 

Used  in  EDIT  to  count  the  number  of  prints  (short 
and  long)  since  the  last  tape  dump. 

NZ 

»  Z(19) 

Defined  and  used  in  EDIT  for  1-D  problems.  NZ  = 
4**NRZ.  After  rezoning  the  grid  NZ  is  used  to  scale 
the  values  printed  by  EDIT  for  the  total  mass,  energy 

and  momentum. 

p 

Global 

Cell- pressure.  IMAX  by  JMAX  array.  Calculated  in  ES. 

Used  by  PHI.  The  P-storage  space  is  used  for  UK,  VK, 

and  RHO  storage  in  PH3*  The  P-array  is  initialized 

at  the  beginning  of  PH3* 

PI 

Local 

P2 

Local 

P3 

Local 

P4 

P5 

Local 

Local 

,  Used  in  ES  as  storage  for  various  terms  in  the 

P6 

Local 

pressure  equations. 

P8 

Local 

P9 

Local 

P12 

Local  , 

PABOVE 

Local 

Used  in  PHI  as  storage  for  pressure  at  top  of  cell. 

PBLO 

Local 

Used  in  PHI  as  storage  for  pressure  at  bottom  of  cell 

PIDTS 

Local^  Defined  and  used  in  PHI  as  l./(n*DT*DY). 

Defined  and  used  in  PH2  as  l./(m*DT). 

PIDY 

=  z(8) 

Defined  in  INPUT:  =  n.  Used  in  REZONE,  SETUP,  PHI, 

PH2,  and  PH3» 

PK 

Global 

Used  in  SETUP  and  INPUT  foi  defining  input  parameters 

(See  Appendix  A.)  PK(3)  used  in  EDIT  to  signal  a 

"long"  or  "short"  print  on  first  cycle  of  a  restart 

run. 
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(  p  ) 

PL  Local  Usee1  in  FH1  for  saving  pressures  on  left  side  of 

cell.  Used  in  EDET  for  crater  depth  printout. 

Equivaienced  in  standard  ClIL-RPM  as  follows: 

PL  =  RST  (for  ?H3) 

PL  =  PR  =  GAKC  (for  PH2) 

PL(  103 )  =  SIGC  (for  PII2) 

PMIN  =  Z(86)  Used  as  a  pressure  cut-off.  Calculated  and  printed 

in  CDT  as  (CQ)  •  (pQ)  >  (U^)  .  initially  defined 
in  INPUT  as  106. 

(r) 

PR  Local v  '  Used  in  INPUT  and  EDIT  for  temporary  storage. 

PRAMOA  Local  Printed  and  calculated  in  EDIT.  The  positive  radial 

momentum  above  JFROJ.  Equivaienced  to  PR (8)  in  EDIT 
only. 

PRAMOB  Local  Printed  and  calculated  in  EDIT.  The  positive  radial 

momentum  below  JPROJ.  Equivaienced  to  PR(l6)  in 
EDIT  only. 

PRDELT  =  Z(45 )  INPUT  parameter.  Gives  the  initial  time  interval 

between  EDIT  prints.  There  are  five  parameters  which 
control  printing  frequency:  PRDELT,  IPCYCL,  PRLIM, 

PRFACT,  and  NUMSCA.  If  the  user  is  printing  on  time 
(PRDELT  i  0.  and  IPCYCL  =  0.),  DT  will  he  adjusted  so 
that  a  print  will  occur  exactly  every  PRDELT  seconds. 

If  the  user  is  printing  on  cycles  (PRDELT  =0., 

F-CYCL  4  0*)ja  print  will  occur  every  IPCYCL  cycles. 

PRLIM,  PRFACT  and  NUMSCA  are  used  to  increase  the 

print  interval.  PRLIM  is  the  time  (or  cycle)  at  which 

PRDELT  (or  IPCYCL)  and  PRLIM  are  multiplied  by  PRFACT. 

The  new  value  of  PRLIM  establishes  the  next  time  (or 

cycle)  when  the  print  Interval  will  be  rescaled. 

This  process  continues  at  most  NUMSCA  times. 

EXAMPLE:  You  wish  to  print  every  1  x  10"®  sec.  until 
you  reach  .1  x  10" 7  see.,  then  every  1  :<  10“ 7  sec.  until' 
1  x  10~6  see.  and  every  1  x  10“ °  sec.  thereafter: 

PRDELT  «  1.  x  rO'8  PRFACT  =  10. 

PRLIM  =  1.  x  10" 7  NUMSCA  =  2. 
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PROB  =  Z(l) 

FROJI  =  Z(l6) 

PROJU  »  Z(73) 

PROPI  Local 


PRR  Local 

PRTIMS  =  Z(131) 

PRXRT  =  Z(69) 

PRYBOT  =  Z(6T) 


INPUT  paramete r.  Used  in  EDIT  as  a  factor  for  rescaling 
PRDELT,  IFCYCL, .  and  PRLIM  when  PRLIM- time  or  cycle  is 
reached.  (Gee  PRDELT.)  Should  be  >  1. 

INPUT  parameter:  '•■‘-me  or  cycle'  at  vhich  to  rescale 
PRDELT  (or  IPCYCL)  and  PRLIM  by  PRFACT.  (See  PRDELT. ) 

Used  and  calciua-i-^d  in  EDIT.  Total  mass  below  JPROJ. 
Equivalenced  to  PR(l2)  in  EDIT  only. 

Used  and  calculated  in  EDIT.  Total  axial  momentum 
below  JPROJ.  Equivalenced  to  PR(l2)  in  EDIT  only. 

Used  and  calculated  in  EDIT.  Total  positive  axial 
momentum  below  JPROJ.  Equivalenced  to  PR ( 14 )  in 
EDIT  only. 

INPUT  parameter.  Identifying  problem  number.  Used 
in  EDIT  and  INPUT. 

INPUT  parameter.  Initial  specific  internal  energy 
of  projectile.  Used  in  SETUP  and  REZONE. 

INPUT  parameter.  Initial  radial  velocity  of  projectile. 
(Usually  =  0}  Used  in  SETUP  and  REZONE. 

Calculated  and  used  in  EDIT.  For  1-D  problems  the 
totals  for  energy,  mass,  momentum  per  unit 
area  are  printed,  (i.e.,  they  are  divided  by 
4**  (Number  of  rezones))  and  stored  in  PROPI  for  printing. 

Used  in  PHI  as  temporary  storage  of  pressure  and 
pressure  averages. 

Initially  set  to  PRDELT  in  INPUT.  Thereafter  cal¬ 
culated  in  EDIT.  When  T  =  PRTIMS,  it  is  time  to  print. 

INPUT  parameter.  The  outer  radius  of  projectile  (in 
cms,).  PRXRT  must  be  at  a  cell-boundary.  Used  in 
SETUP  and  R3Z0NE. 

INPUT  parameter.  Y-value  of  bottom  of  projectile  (in 
cms. ).  PRYBOT  should  be  at  a  cell-boundary.  If  no 
"projectile"  is  to  be  generated,  PRYBOT  should  be 
set  to  -1.  Used  in  SETUP  and  REZONE. 
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PSCLE  Local  Used  in  MAP  as  a  logarithmic  scale  factor  for  the 

pressure  maps. 

PTEMP  Local  Used  in  CUT  when  calculating  JPM  array  (the  maximum 

pressure  location  in  each  column). 

FW  Local  Us-~d  in  PH3  to  calculate  plastic  work  when  INTER  = 

RADIUS  =  PK(l2)  INPUT  parameter.  Radius  of  sphere  (in  cms.).  The  radius 

=  Z(l62)  need  not  be  a  multiple  of  DX.  Used  in  SETUP.  Equivalence! 
to  PK(12)  in  SETUP. 

RAMCX1A  Local  Printed  and  calculated  in  EDIT.  Total  radial  momentum 

above  JPROJ.  Equivalence!  to  PR(7)  in  EDIT  only. 

RATIO  Local  Used  in  CDT  xn  calculation  of  DT.  Ratio  of  (DX, DY)^^ 

to  (U,V,  local  sound  sPee^)tnax* 

RC  Local  Used  and  calculated  in  PHI  as  distance  from  axis  to 

center  of  a  cell. 

RBLERR  Local  Used  in  EDIT  for  storing  and  printing  maximum 

relative  error  in  the  energy  sum. 

REZ  =  2(95)  Flag  defined  in  PH2  and  vised  in  EDIT.  Signals  when 

the  REZONE  subroutine  should  be  called.  (The  rezone 
flag  is  turned  on  when  material  begins  to  flow  out 
through  transmittive  boundaries.  In  REZONE  each  set 
of  four  cells  in  the  mesh  is  made  into  one  cell.  The 
new  mass  is  the  sum  of  nasses  in  the  four  original 
cells.  Momentum  and  total  energy  are  conserved  but  in  ■ 
so  doing  some  kinetic  energy  is  changed  to  internal. 

(The  result  is  that  rezoniog  has  a  stabilizing  in¬ 
fluence.)  When  all  permitted  rezones  have  been  done, 
material  is  allowed  to  flow  out  through  transmittive 
boundaries  and  the  mass  and  energy  are  lost  from  the 
system. 

REZFCT  =  Z(7l)  INPUT  flag  for  rezoning.  If  =  1.,  the  grid  is  rezoned 

(NUMREZ)  times.  If  =  0.,  no  rezoning  is  done.  Tested 
in  PH2  and  EDIT. 
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RHINI 


=  Z(lll)  INPUT  parameter.  Initial  density  of  projectile.  Used 
in  SETUP  and  REZONE.  In  PH?  it  is  used  to  determine 
whether  material  should  be  evaporated.  (See  EVA?) 

RHINIT  =  Z(l5)  INPUT  parameter.  Initial  density  of  target.  Used  in 

SETUP  and  REZONE. 

(c) 

RliO  Local  Used  in  PK3  for  temporary  storage  of  cell  density. 

P.HOFIL  =  Z(5l)  INPUT  parameter.  Initial  density  of  filler  material 

between  the  projecti3.e  and  target.  Used  in  SETUP 
and  REZONE. 

RHC?"  =  Z(138)  INPUT  parameter.  Cells  with  p  <  RHCMIN  are  by-passed 

in  calculation  of  DT. 

RHOOUT  =  Z(103)  INPUT  parameter.  Used  in  SETUP.  In  cells  containing 

sphere  boundary  RHOOUT  is  the  density  of  material 
outside  sphere.  Equivalenced  to  Z(l03)  and  EVAPMV 
in  SETUP. 

RHOSPH  =  Z(100)  INPUT  parameter.  Used  in  SETUP  as  the  initial  density 

of  sphere.  Equivalenced  to  Z(10Q)  and  EVAFM  in 
SETUP. 

RHCM  Global  Density  of  cell.  Calculated  in  CDT,  used  in  ES. 

Equivalenced  to  NULLS  in  CDT  and  ES. 

RHOZ  =  Z(115)  INPUT  parameter.  Normal  density.  Used  in  INPUT,  CUT, 

ES,  EDIT,  PH2  and  PH3* 

ROEPS  =  Z(llO)  INPUT  parameter.  Round-off  epsilon  used  in  calculating 

cutoffs.  Used  in  CDT  to  calculate  IMIN. 

UMIN  -  ( ROEPS )  ( |  maximum  u  or  v|  ) 

Used  in  SETUP,  EDIT  and  PH2. 

RR  Local  Used  and  calculated  in  PHI.  Distance  (cms.)  from  axis 

to  center  of  cell  on  the  right. 

RTM  =  Z(5?)  Calculated  in  PK2.  printed  in  EDIT.  Total  trass  lost 

out  right  side  of  grid. 
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RTMU 

=  Z(10) 

RTMV 

=  z(58) 

SAVEK 

Local 

SIEMIN 

Global 

sienew 

Local 

SIESPH 

=  Z(101) 

SIGC 

Local^C^ 

SIGMU 

Local 

SICW 

Local 

SN 

-  Z(65) 

SMB 

LoeadC> 

SNL 

-  Z(105) 

SNLX 

Local 

SNR 

Local^C  ^ 

SNT 

Local^ 

Calculated  in  PH2.  Printed  in  EDIT.  Total  radial- 
momentum  lost  out  right  side  of  grid. 

Calculated  in  PH2.  Printed  in  EDIT.  Total  axial- 
momentum  lost  out  right  side  of  grid. 

Used  and  calculated  in  F:i2,  Factox'  used  in  calculation 
of  energy  fluxes  across  right  and  top  boundaries  of 
cells  on  reflective  boundaries. 

Used  in  MAP,  PH2.  Calculated  in  CET.  SIE  cut-off 
value  =  (UMIN)2. 

Used  and  calculated  in  PH2.  New  value  of  specific 
internal  energy. 

INPUT  parameter.  Initial  value  of  specific  internal 
energy  of  sphere.  Equivalence!  to  Z(lOl)  and  EVAPEN 
in  SETUP. 

Used  in  PH2  for  energy  carried  by  mass  moving  across 
left  side  of  cell.  Equivalence!  to  PL(l03).  (See 
Appendix  B. ) 

Used  in  PH2  for  radial  momentum  moving  across  cell- 
boundaries  . 

Used  in  FH2  for  axial  momentum  moving  across  cell- 
boundaries  . 

INPUT  flag:  When  =  0.  negative  internal  energy  is  to 
bo  set  to  0.  When  =  1.  negative  internal  energy  is 
to  be  ieft  alone.  Used  in  PHI  and  PH2. 

Used  in  PH3  for  normal  stress  at  bottom  of  a  cell. 
Equivalence!  to  P(313)» 

Used  in  PH3  for  normal  stress  at  left  of  a  cell. 

Used  in  PH3 •  =  SNL  *  X(l-l). 

Used  in  PH3  for  normal  sli*ess  at  right  of  a  cell. 

(=S11  at  right.) 

Used  in  PH3  for  normal  stress  at  top  of  a  cell. 

{-  S20  at  top.) 


159 


Mi  wv  V*rn*»mmm  . .  —  ■  -  *  *-  •  -  — 


SOLID 

Global 

C;  ’  ulated  in  INPUT  ns  (RliOZ  *  AMDM).  Used  in  PH2, 
1.1$  and  CDT. 

SRATIO 

Local 

Used  in  CDT  to  calculate  DT.  rhe  smallest  ratio  of 

minimum  cell  dimension  to  maximum  velocity. 

SSI 

=  Z(127) 

Calculated  in  INPUr.  Used  in  ES:  =  l./(ESESP-ESES). 

SS2 

a  Z(128) 

INPUT  parameter  controlling  reflective  (and  axis) 
boundary  treatment.  Usually  =  1.  Used  in  PH2. 

SS4 

=  Z(130) 

INPUT  parameter.  If  SS4  ■/  0.,  REZONE  is  called  on 
second  cycle  of  run.  Used  in  EDIT. 

STAB 

=  2.(139) 

INPUT  parameter.  Used  in  CUT.  Initial  value  of 

"stability  fraction"  for  the  calculation  of  DT.  If 
FINAL  =  O.j  STAB  is  constant.  Otherwise  its  value 

progresses  from  STAB  to  FINAL  in  a  geometric  pro¬ 
gression. 

STB 

Local^0^ 

Used  in  PHj  for  shear  stress  at  bottom  of  cel’ 

Equivalenced  to  P( 3^5 ) » 

STEZ 

=  z(29) 

INPUT  paran.  ;ter:  EQ.  Used  in  yield-  stre  .jth  cal¬ 
culation  in  PH3*  See  STRENG. 

STKL 

=  Z(ll) 

INPUT  parameter:  Y^.  Used  in  yield- strength  cal¬ 
culation  in  PH3»  See  STRENG. 

STX2 

=  Z(28) 

INPUT  parameter:  Yp.  Used  in  yield- strength  cal¬ 
culation  in  PH3.  See  STRENG. 

STL 

=  Z(106) 

Used  in  PH3  for  shear  stress  at.  left  of  cell. 

STLX 

Local 

Used  in  PH3*  =  STL  *  X(l-l). 

STR 

Local^C  ^ 

Used  in  PH3  for  shear  stress  at  right  of  cell. 

STRENG 

Local 

Calculated  and  used  in  PH3:  yield  strength  of 

material.  (Y q,  Y^,  Yp  supplied  by  user.) 
STRSMG  =  (Yq  +  Yxn  +  Y^2)  •  (l  -  ~) 


STT  =  Z(l43) 

SUM  Local^0^ 

SUME  Local 

SUM1  Local 

SUM2  Local 

T  =  Z(84) 


TARGI  =  Z(72) 

TARGV  =  Z(52) 

(p ) 

TARMAS  Local vw 

TARMV  Local ^ 

TARMVP  Local^ 

TAU  Global 


If  STRENG  <0.,  stresses  are  set  to  0. 

If  E  >  EQ,  CTREWG  =  0. 

Yq  if  JZERO, 
is  STK1, 

Yg  is  STK2, 
pQ  is  RHOZ, 

E  is  AIX  of  cell, 

EQ  is  STEZ, 
p  is  density  of  cell, 
p.  =  P/P0  -  1* 

Used  in  PH3  for  shear  stress  at  top  of  cell. 

Used  in  PH2.  Sums  negative  internal  energy  when 
negative  internal  energy  is  set  to  zero. 

Used  in  PH2.  Sums  energy  changes. 

Used  .in  SETUP  to  define  JRADA. 

Used  in  SETUP  to  define  JRADB. 

Time  in  seconds.  Initially  defined  in  INPUT.  Incre¬ 
mented  in  COT.  Adjusted  in  EDIT  for  printing. 
Printed  by  COT,  EDIT,  REZONE. 

INPUT  parameter.  Initial  value  of  specific  internal 
energy  of  target.  Used  in  SETUP  and  REZONE. 

INPUT  parameter.  Initial  value  of  axial- velocity  of 
target.  Used  in  SETUP  and  REZONE. 

Used  in  EDIT.  Total  mass  above  JPROJ.  Equivalenced 
to  PR(U)  in  EDIT  only. 

Used  in  EDIT.  Total  axial  momentum  above  JPROJ. 
Equivalenced  to  PR(5)  in  EDIT  only. 

Used  in  EDIT.  Total  positive  axial  momentum  above 
JPROJ.  Equivalenced  to  PR(6)  in  EDIT  only. 

Calculated  in  SETUP  and  REZONE.  Area  of  cell  face: 

=  n(x(l)^  -  X(l-l)^).  Used  in  most  subroutines. 


TAUDTS 


Local 
TAXRT  =  Z(IOT) 

TAYBOT  =  Z(88) 

TAYTOP  =  Z(89) 

TEPRO  Local^C  ^ 

TESTRH  Global 

(c) 

TETAR  Local'  ' 

TH03  Local 

(c) 

TIEPRO  Local'  ' 

TIETAR  Local^C^ 

(c) 

TKEPRO  Local'  ' 

(C) 

TKETAR  Local'  ' 

TMA  Local 

TNCW  Local 

TOFM  =  Z(63) 


Used  and  calculated  in  PHI:  =  TAU*£T. 

INPUT  parameter.  Outer  radius  of  target  (in  cms.). 
TAXRT  should  be  at  a  cell-boundary.  Used  in  SETUP 
and  REZONE . 

INPUT  parameter.  Axial  location  of  bottom  of  target 
(in  cms).  TAIBOT  should  be  at  a  cell-boundary.  If  no 
"target, "  TAYBOT  =  -1.  Used  in  SETUP  and  REZONE. 

INPUT  parameter.  Axial  location  of  top  of  target  (in 
cms).  TAYTOP  should  be  at  a  cell-boundary.  Used  in 
SETUF  and  REZONE. 

Used  in  EDIT.  Total  energy  below  JPROJ.  Equivalenced 
to  PR(ll)  in  EDIT  only. 

Calculated  in  INPUT:  =  (.2)*RH0Z.  Used  in  CUT  in 
defining  pressure  scale  factor. 

Used  in  EDIT.  Total  energy  above  JPROJ.  Equivalenced 
to  PR(3)  in  EDIT  only. 

Used  and  calculated  in  PH3 :  =  +  +  “  ^  • 

Used  in  EDIT.  Total  internal  energy  below  JPROJ. 
Equivalenced  to  ?R(9)  in  EDIT  only. 

Used  in  EDIT.  Total  internal  energy  above  JPROJ. 
Equivalenced  to  PR(l)  in  EDIT  only. 

Used  in  EDIT.  Total  kinetic  energy  below  JPROJ. 
Equivalenced  to  PR(lO)  in  EDIT  only. 

Used  in  EDIT.  Total  kinetic  energy'  above  JPROJ. 
Equivalenced  to  PR(2)  in  EDIT  only. 

Used  in  MAP  to  associate  a  given  density  with  the 
printed  symbol. 

Used  in  EDIT:  =  time  now;  saved  when  EDIT  calls  CDT 
after  calling  REZONE. 

Calculated  in  FH2.  Printed  in  EDIT.  Total  mass  lost 
out  top  of  grid. 
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TOPMU 

=  Z(9) 

TOPMV 

=  z (66) 

TOTSPH 

Local 

TRIAL 

Local 

TRNSFC 

=  Z(l45) 

TSTOP 

=  2(50) 

twopdt 

Local 

TWOPI 

Global 

U 

Global 

UAMMP 

Local 

UAMPY 

Local 

UBAR 

Local 

USEF 

Local 

UK 

Lc=al<C> 

UKT 

Local 

UL 

Local ^ 

UMIN 

=  Z(129) 

Calculated  in  PH2.  Printed  in  EDIT.  Total  radial- 
momentum  lost  out  top  of  grid. 

Calculated  in  PH2.  Printed  in  EDIT.  Total  axial- 
momentum  lost  out  top  of  grid. 

Used  in  SETUP.  Total  volume  of  sphere. 

Used  in  CDT.  Maximum  sound- speed  or  velocity  used  to 
define  ET. 

Defined  in  INPUT:  =  .4.  Used  in  PH2  to  define  maxi¬ 
mum  transport  velocity.  (See  UVKAX. ) 

INPUT  parameter.  Value  of  T  at  which  execution  stops 
when  stopping  on  time  rather  than  cycles. 

Calculated  and  used  in  PH2:  =  2*«*DT. 

Calculated  in  INPUT.  Used  in  PH3:  =  2m. 

Radial  velocity  of  cell.  (IMAX  by  JMAX  array.) 

Used  in  PH2  for  U  of  mass  moving  across  right  cell- 
edge  . 

Used  in  PH2  for  U  of  mass  moving  across  top  cell- 
edge. 

Used  in  PH3  in  calculating  energy  sum. 

Used  in  PH2  to  move  tracer- points. 

Used  in  FH3*  Temporary  storage  for  part  of  U  array. 

Used  in  PH3 •  Temporary  storage  for  U(K). 

Used  in  PHI  for  U  on  left.  Used  in  EDIT  for  crater 
depth  printout.  Equivalenced  as  follows  in  standard 
OIL-RFM: 

UL(103)  =  CHAD  (for  EDIT) 

UL  =  P.SII  (for  PH3 ) 

UL  =  ?L£fT  (for  PH 2) 

UL( 103 )  =  YAKC  (for  PH2) 

Calculated  in  CUT.  Used  as  velocity  cutoff  in  PH 2, PH3, 
and  MAP:  =  (POEFA )*( maximum  sound-speed  or  velocity). 


UMK 

Local 

Calculated  and  used  in  PH2.  Temporary  storage  for 

u(k)*amx(k). 

UMKP 

Local 

Calculated  and  used  in  PH2.  Temporary  storage  for 

u(k+i)*amx(k+i). 

UMOM 

Local 

Calculated  and  used  in  PH2:  =  MASS*U(K). 

UNxxx 

=  Z(xxx) 

Unused  Z- storage. 

UNEW 

Local 

Calculated  and  used  in  PH2.  Hew  value  of  U. 

UOTK 

Local 

Calculated  and  used  in  PH2:  =  UMX/TAU(l). 

UOTKP 

Local 

Calculated  and  used  in  PH2:  =  UMKP./?AU(l+l). 

UOX 

Local 

Used  in  PH3:  =  U/X. 

URR 

Local^0^ 

Used  in  PH_  and  PH2.  Temporary  storage  for  velocity 

and  velocity  averages. 

USCLE 

Local 

Used  in  MAP  as  logarithmic  scale  factor  of  radial 

velocity  map. 

UVMAX 

=  Z(22) 

Used  and  calculated  in  PH2.  Maximum  transport  velocity 
In  radial  direction  UVMAX  =  TRNSFC*DX(l)/DT. 

In  axial  direction  UVMAX  =  TRNSFC*DY( J)/DT. 

V 

Global 

Axial  velocity  of  cell.  (IMAX  by  JMAX  array.) 

VABOVE 

Local 

Used  in  PHI  and  PH2  as  storage  for  velocity  at  top 

of  cell. 

VALUE 

Local 

Used  in  MAP  in  printing  maximum  value  of  each  map 

symbol. 

VAMMP 

Local 

Used  in  PH2  for  axial  velocity  of  mass  moving  across 

right  cell- edge. 

VAMPY 

Local 

Used  in  PH2  for  axial  *  elocity  of  mass  moving  across 

top  cell- edge. 

VBAR 

Local 

Used  in  PH3  in  calculating  energy  sum. 

VBLO 

Local 

Used  in  PHI  as  storage  for  velocity  at  bottom  of  cell. 

VF.FF 

Local 

Used  in  PH2  to  move  tracer  points. 

VEL  Local  Used  in  PHI  as  subcycle  flag. 

VFACT  Local  Used  in'  PH3  in  setting  boundary  conditions. 

VINI  =  Z(lI2)  INPUT  parameter.  Initial  axial  velocity  of  projectile. 

Used  in  SETUP  and  REZONE. 

VINSPH  =  Z(l02)  INPUT  parameter.  Initial  axial  velocity  of  sphere. 

Used  in  SETUP.  Equivalenced  to  Z(l02)  and  EVAFMU 
in  SETUP. 

fc) 

VK  Local  Used  in  PH3*  Temporary  storage  for  part  of  V  array. 

VKT  Local  Used  in  PH3*  Temporary  storage  for  V ( K ) . 

VMK  Local  Calculated  and  used  in  PI12:  =  V(k)*AMX(k). 

VML  Local  Calculated  and  used  in  PH2:  =  V(K+IMAX)*AKX(K+IMAX). 

‘/NEW  Local  Calculated  and  used  in  PH2.  New  value  of  V. 

VOLSPH  Local  Calculated  and  used  in  SETUP.  Volume  of  toroid  gen¬ 

erated  by  a  cell.  Used  in  setting  up  sphere. 

VO.-:  Local  Calculated  and  used  in  ES. 

=  (normal  density )/(density  of  cell). 

VSCLE  Local  Used  in  MAP  as  logarithmic  scale  factor  for  axial 

velocity  map. 

VT  =  Z(55)  INPUT  parameter.  Used  in  PH2  as  minimum  mass  flux 

(across  top  or  right  side  of  one  boundary  cell  in  one 

cycle)  needed  to  trigger  a  rezone.  Usually 

-4 

VT  ~  pQ  x  10  . 


WDYF 

Local 

Used  in  PH2  as  temporary  storage  for  DY(j)  or  PY(j+l) 

WFLAGF 

Gobal 

Used  in  INPUT  and  EDIT.  Flags  first  cycle.  Set  =  1. 

in  INPUT.  Set  =  0.  in  EDIT. 

WFLAGL 

Global 

Used  in  MAIN  and  EDIT.  Flags  last  cycle.  Set  -  1. 

in  EDIT. 

WFL4GP 

Local^ 

Used  in  EDIT.  Flags  beginning  of  printout  of  pro¬ 
perties  for  each  cell  in  a  given  column. 
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ws 

Local^0^ 

Used  in  most  subroutines  fox'  local  working  storage. 

WSA 

Local 

Used  in  most  subroutines  for  local  working  stoi'age. 

WSB 

Local 

Used  in  most  subroutines  lor  local  working  storage. 

WSC 

Local 

Used  in  most  subroutines  for  local  working  stoi'age. 

WSD 

Local 

Used  in  PH2  local  working  storage. 

WSMAX 

Local 

Used  in  MAP  to  define  scale  factors. 

WSMIN 

.Local 

Used  in  MAP  to  define  scale  factors. 

WSOUT 

Local 

Used  in  PH2  for  adjusting  over-emptied  cells. 

WT 

Local 

Used  in  CUT  for  local  working  storage. 

WTA 

Local 

See  WT. 

WTB 

Local 

See  WT. 

X 

Global 

Distance  (cms)  from  axis  to  outside  of  cell.  Equi- 
valenced  to  XX  array  such  that  X(0)  =  XX(l). 

XIENRG 

=  Z(lUG) 

Total  internal  energy.  Calculated  in  EDIT  and  used 

for  printing  labels  on  tx-acer  point  plots. 

XKENRG 

»  Z(l4l) 

Total  kinetic  energy.  Calculated  in  EDIT  and  used 

for  printing  labels  on  tracer  point  plots. 

XL2 

Local 

Calculated  and  used  in  SETUP  for  placing  sphere: 

=  (X(i-l))2. 

XMAX 

*  Z(l8) 

Calculated  in  SETUP:  =  X(IMAX).  • 

XP 

Global 

Tracer- point  x- coordinates.  Used  in  INPUT,  SETUP, 

EDIT,  PH2  and  REZONE. 

XRc 

Local 

Calculated  and  used  in  SETUP  for  placing  sphere: 

=  (X(I))3. 

XTENRG 

=  Z(lH2) 

Total  energy.  Calculated  in  EDIT  and  used  for  printing 

labels  on  tracer  point  plots. 

XUM 

Cons  tants 

Used  in  MAP,  Has  negative  alphabetic  characters  for 

maps.  Defined  In  DATA  statement. 
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XX 


Global 


Equivalence!  to  X  array  so  as  to  make  X(0)  available. 

Y  Global  Distance  (cms)  from  bottom  of  grid  to  top  of  cell. 

Equivalence!  to  YY  array  such  that  Y(0)  -  YY(l). 

Y2  =  Z(8l)  INPUT  ti-acer  point  flag:  when  =  -2,  tracer  points 

are  calculated;  when  =  0,  tracer  points  not  calculated. 

(c ) 

YAMC  Local  Calculated  and  used  in  PH 2.  Axial  momentum  of  mass 

moving  across  1  ft  side  of  cell.  Equivalence!  to 
UL( 103 ) .  (See  Appendix  B) 

YBOTTM  Local  Calculated  and  used  in  SETUP  in  placing  sphere: 

=  Y(J-1). 

YC2  Local  Calculated  and  used  in  SETUP  in  placing  sphere: 

=  (YCEiJTR)2. 

YCENTR  =  PK(13)  INPUT  parameter.  Distance  (cms)  of  center  of  sphere 

=  Z(l63)  from  bottom  of  grid.  YCENTR  must  be  at  a  cell- 

boundary.  Used  in  SETUP.  Equivalence!  to  PK(13) 
in  SETUP  only. 

YDIFFB  Local  Calculated  and  used  in  SETUP  in  placing  sphex-e. 

YDIFFI  Local  Calculated  and  used  in  SETUP  in  placing  sphere. 

YDIFFO  Local  Calculated  and  used  in  SETUP  in  placing  sphere. 

YDIFFT  Local  Calculated  and  used  in  SETilP  in  placing  sphere. 

YLTNTA  Local  Calculated  and  used  in  SETUP  in  placing  sphere. 

YLINTB  Local  Calculated  and  used  in  SETUP  in  placing  sphere. 

YLCUER  Local  Calculated  and  used  in  SETUP  in  placing  sphere. 

YMAX  Local  Calculated  in  SETUP:  =  Y(JMAX). 

YP  Global  Tracer- point  y- coordinates.  Used  in  INPUT,  SETUP, 

EDIT,  PH2  and  REZONE. 

YRINTA  Local  Calculated  and  used  in  SETUP  in  placing  sphere. 

YRIiJTB  Local  Calculated  and  used  in  SETUP  in  placing  sphere. 

YTOP  Local  Calculated  and  used  in  SETUP  in  placing  sphere. 
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f?  y 


* 

* 

YUPPER 

Local 

Calculated  and  used  in  SETUP  in  placing  sphere. 

YY 

Global 

Equivalenced  to  Y  array  so  as  to  rake  Y(0)  available. 

t. 

Z 

Special 

Global 

Storage  for  most  of  the  input  parameters.  The  Z-array 
(150  words)  i.  written  on  tape  for  restarts.  Used  in 

INPUT,  MAIN,  and  SETUP.  (See  Appendix  A) 


APPENDIX  A 

Z- STORAGE  LISTED  NUMERICALLY 


See  Dictionary  i’or  meaning  an<I  use. 


*1. 

PROB 

30. 

WC 

2. 

CYCLE 

31 

UN  31 

3. 

DT 

32. 

NRC 

4. 

NUMSP 

2*33- 

IMAX 

2*5. 

NFRELP 

34. 

IMAXA 

2*6. 

NDUMP7 

2*35- 

JMAX 

2*7. 

ICSl’QP 

36. 

J1-1AXA 

8. 

PIDY 

37. 

KMAX 

9. 

TOPMU 

38. 

KMAXA 

10. 

RTMU 

39. 

BOTM 

*11. 

S'TKl 

40, 

BOTMV 

2*12. 

NUMREZ 

41. 

RUMS  FT 

13. 

ETH 

*42. 

CZERO 

14. 

UNl4 

2*43. 

NUMSCA 

*15. 

RHINIT 

*44. 

PRLIM 

*16. 

PROJI 

*45. 

REDELT 

17. 

UN17 

*46. 

PREACT 

18. 

XMAX 

2*47. 

11 

19. 

NZ 

2*48. 

12 

20. 

NREZ 

2*49. 

IPCYCL 

*21. 

AMDM 

1*R  50. 

TSTOP 

22. 

UVMAX 

*51. 

RliOFIL 

23. 

U?I23 

*52. 

TARGV 

*24. 

BMW 

53- 

N3 

2*25. 

JSTR 

2*54. 

IVARDY 

26. 

DTNA 

55. 

VT 

*27. 

CVIS 

2*96. 

n6 

* 

ro 

CO 

• 

STK2 

37. 

RTM 

*29. 

STEZ 

58. 

ETMV 

*  User- supplied  input- values . 

2*  Must  have  a  "2"  in  column  1. 
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59- 

UN59 

60. 

N10 

61. 

Nil 

62. 

GAMMA 

63* 

TOFM 

64. 

BOTMU 

*65. 

SN 

66. 

TOPMV 

*67. 

PRYBOT 

*63. 

PRrrop 

*69. 

■°RXRT 

*70. 

CYCPK3 

*71. 

REZFCT 

*72. 

TARGI 

*73  • 

PROJU 

74. 

BBOUND 

*75- 

EVAP 

76. 

ECK 

77. 

NEOYCL 

78. 

II 

79. 

TJ 

80. 

NMP 

*81. 

Y2 

82. 

EZPH1 

2*83. 

IVARDX 

84. 

T 

2*85. 

NMFKAX 

86. 

PMIN 

2*87. 

INTER 

1*  Must  have  a  *'l"  in  column  1. 

R  Must  be  included  in  a  restart  input 
input  deck. 


*83‘.  TAYBOT 

*122.  ESE3 

*R153*  PK( 3 )  •  When  -  -1m 

*89.  TAYTOP 

*123.  ESALPH 

program  will  restart 
from  l-po  and  do  a 

90.  IEMAP 

*124.  ESBETA 

"long”  EDIT  print  of 

91.  MC 

*125 .  ESCAPB 

the  pickup  cycle. 

When  =  ~2.}  program 

92.  MR 

126.  IUMAP 

will  res  Lai t  from 

93.  HZ 

127.  SSI 

tape  and  do  a  "short" 
EDIT  print  of  the 

94.  MB 

128.  SS2 

pickup  cycle. 

95.  REZ 

129.  UMIN 

*162.  Radius  of  sphere 

2*96.  NODUMP 

*130.  SS4 

(RADIUS). 

97.  UN97 

131.  PRTIMS  • 

*163.  Y- center  of 

sphere  ( YCENTR ) • 

98.  UN98 

132.  EOR 

1*164.  When  Z(l64)  >  0. 

99.  UN99 

133.  EOT 

CARDS  will  be 

*100.  evafm(rhosph) 

134.  EOB 

called  by  SETUP 
to  read  "special" 

*101.  EVAPEil  (  SIESPH  ) 

135.  EMOR 

input.  (See  "OIL- 

*102,  evafmu(vinsph) 

*136.  DXF 

RPM  Input  for 

Special  Setup" 

*103.  EVAPMV  ( RH001/T ) 

*137.  DYF 

on  page  23. ) 

toll.  EZPH2 

*138.  RHCMIN 

105.  SNL 

*139.  STAB 

106.  STL 

140.  XIENRG 

*107.  TA)PT 

141.  XKENRG 

108.  IDNMAP 

142.  XTENRG 

109.  IPRMAP 

143.  STT 

*110.  ROEPS 

*114.  DTMIN 

*111.  RHIMI 

145.  TRNSFC 

*112.  VIMI 

146.  EMOT 

*113.  FINAL 

2*147.  JPROJ 

114.  IVMAP 

148.  CilAUT 

*115.  RHOZ 

*1.49.  BEAR 

K 


*116.  ESA 
*117.  ESSZ 
*118.  ESB 
*119.  ESCAPA 
*120.  ESESP 
*121.  ESESQ 


L*150.  EM03  =  0  (Late  card  cf  input  unless 
restarting  from  tape.) 

PK  array  follows  the  Z  array  in  Blank 
Common;  so  PK(l)  from  the  beginning  of 
Blank  Common  is  equivalent  to  Z(i5l)* 

1*«151.  FK( 1 )  should  be  the  same  as  PROS. 

*R152.  Cycle  to  restart  on. 
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APPENDIX  B 

VARIABLES  USED  FOR  FLUXES  ACROSS  CELL  BOUNDARIES 


Mass 


Energy 


GAKC(  J) 


AM14P  STGC(j) 


•->  DELER 


Amt 


DELEB 


Radial  Momentum 


Axial  Momentum 


ARijr 

A 


AMVT 

A 


1 

flsft(j)  -- 

r r 

I  \  _ 

✓ 

— J>  AMUR  YAMC(j)  - 

-> 

— 

k>  AMVR 


AMMU 


m 


AMMV 
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